KIDS Distribution saved on Jan 30, 2025@13:21:51
PCC V2.0 PATCH 30
**KIDS**:BJPC*2.0*30^

**INSTALL NAME**
BJPC*2.0*30
"BLD",7110,0)
BJPC*2.0*30^IHS PCC SUITE^0^3250130^y
"BLD",7110,4,0)
^9.64PA^9000010.07^4
"BLD",7110,4,9000010.07,0)
9000010.07
"BLD",7110,4,9000010.07,2,0)
^9.641^9000010.07^1
"BLD",7110,4,9000010.07,2,9000010.07,0)
V POV  (File-top level)
"BLD",7110,4,9000010.07,2,9000010.07,1,0)
^9.6411^1108^2
"BLD",7110,4,9000010.07,2,9000010.07,1,1107,0)
DATE OF DIAGNOSIS
"BLD",7110,4,9000010.07,2,9000010.07,1,1108,0)
DATE RESOLVED
"BLD",7110,4,9000010.07,222)
y^y^p^^^^n^^n
"BLD",7110,4,9000010.07,224)

"BLD",7110,4,9000011,0)
9000011
"BLD",7110,4,9000011,2,0)
^9.641^9000011^1
"BLD",7110,4,9000011,2,9000011,0)
PROBLEM  (File-top level)
"BLD",7110,4,9000011,2,9000011,1,0)
^9.6411^3.01^2
"BLD",7110,4,9000011,2,9000011,1,.24,0)
DATE OF DIAGNOSIS
"BLD",7110,4,9000011,2,9000011,1,3.01,0)
SOURCE OF DATE OF DIAGNOSIS
"BLD",7110,4,9000011,222)
y^y^p^^^^n^^n
"BLD",7110,4,9000011,224)

"BLD",7110,4,9000017,0)
9000017
"BLD",7110,4,9000017,2,0)
^9.641^9000017^1
"BLD",7110,4,9000017,2,9000017,0)
REPRODUCTIVE FACTORS  (File-top level)
"BLD",7110,4,9000017,2,9000017,1,0)
^9.6411^1101^1
"BLD",7110,4,9000017,2,9000017,1,1101,0)
CURRENTLY PREGNANT
"BLD",7110,4,9000017,222)
y^y^p^^^^n^^n
"BLD",7110,4,9000017,224)

"BLD",7110,4,9000024,0)
9000024
"BLD",7110,4,9000024,2,0)
^9.641^9000024^1
"BLD",7110,4,9000024,2,9000024,0)
BIRTH MEASUREMENT  (File-top level)
"BLD",7110,4,9000024,2,9000024,1,0)
^9.6411^.23^1
"BLD",7110,4,9000024,2,9000024,1,.23,0)
MULTIPLE BIRTH?
"BLD",7110,4,9000024,222)
y^y^p^^^^n^^n
"BLD",7110,4,9000024,224)

"BLD",7110,4,"APDD",9000010.07,9000010.07)

"BLD",7110,4,"APDD",9000010.07,9000010.07,1107)

"BLD",7110,4,"APDD",9000010.07,9000010.07,1108)

"BLD",7110,4,"APDD",9000011,9000011)

"BLD",7110,4,"APDD",9000011,9000011,.24)

"BLD",7110,4,"APDD",9000011,9000011,3.01)

"BLD",7110,4,"APDD",9000017,9000017)

"BLD",7110,4,"APDD",9000017,9000017,1101)

"BLD",7110,4,"APDD",9000024,9000024)

"BLD",7110,4,"APDD",9000024,9000024,.23)

"BLD",7110,4,"B",9000010.07,9000010.07)

"BLD",7110,4,"B",9000011,9000011)

"BLD",7110,4,"B",9000017,9000017)

"BLD",7110,4,"B",9000024,9000024)

"BLD",7110,6.3)
7
"BLD",7110,"INI")
PRE^BJPC2P30
"BLD",7110,"INIT")
POST^BJPC2P30
"BLD",7110,"KRN",0)
^9.67PA^9002226^21
"BLD",7110,"KRN",.4,0)
.4
"BLD",7110,"KRN",.401,0)
.401
"BLD",7110,"KRN",.402,0)
.402
"BLD",7110,"KRN",.402,"NM",0)
^9.68A^2^2
"BLD",7110,"KRN",.402,"NM",1,0)
APCD BM (BM)    FILE #9000001^9000001^0
"BLD",7110,"KRN",.402,"NM",2,0)
APCD BM EDIT    FILE #9000024^9000024^0
"BLD",7110,"KRN",.402,"NM","B","APCD BM (BM)    FILE #9000001",1)

"BLD",7110,"KRN",.402,"NM","B","APCD BM EDIT    FILE #9000024",2)

"BLD",7110,"KRN",.403,0)
.403
"BLD",7110,"KRN",.5,0)
.5
"BLD",7110,"KRN",.84,0)
.84
"BLD",7110,"KRN",3.6,0)
3.6
"BLD",7110,"KRN",3.8,0)
3.8
"BLD",7110,"KRN",9.2,0)
9.2
"BLD",7110,"KRN",9.8,0)
9.8
"BLD",7110,"KRN",9.8,"NM",0)
^9.68A^5^1
"BLD",7110,"KRN",9.8,"NM",5,0)
APCHS7^^0^B96243259
"BLD",7110,"KRN",9.8,"NM","B","APCHS7",5)

"BLD",7110,"KRN",19,0)
19
"BLD",7110,"KRN",19.1,0)
19.1
"BLD",7110,"KRN",101,0)
101
"BLD",7110,"KRN",409.61,0)
409.61
"BLD",7110,"KRN",771,0)
771
"BLD",7110,"KRN",779.2,0)
779.2
"BLD",7110,"KRN",870,0)
870
"BLD",7110,"KRN",8989.51,0)
8989.51
"BLD",7110,"KRN",8989.52,0)
8989.52
"BLD",7110,"KRN",8994,0)
8994
"BLD",7110,"KRN",9002226,0)
9002226
"BLD",7110,"KRN","B",.4,.4)

"BLD",7110,"KRN","B",.401,.401)

"BLD",7110,"KRN","B",.402,.402)

"BLD",7110,"KRN","B",.403,.403)

"BLD",7110,"KRN","B",.5,.5)

"BLD",7110,"KRN","B",.84,.84)

"BLD",7110,"KRN","B",3.6,3.6)

"BLD",7110,"KRN","B",3.8,3.8)

"BLD",7110,"KRN","B",9.2,9.2)

"BLD",7110,"KRN","B",9.8,9.8)

"BLD",7110,"KRN","B",19,19)

"BLD",7110,"KRN","B",19.1,19.1)

"BLD",7110,"KRN","B",101,101)

"BLD",7110,"KRN","B",409.61,409.61)

"BLD",7110,"KRN","B",771,771)

"BLD",7110,"KRN","B",779.2,779.2)

"BLD",7110,"KRN","B",870,870)

"BLD",7110,"KRN","B",8989.51,8989.51)

"BLD",7110,"KRN","B",8989.52,8989.52)

"BLD",7110,"KRN","B",8994,8994)

"BLD",7110,"KRN","B",9002226,9002226)

"BLD",7110,"PRE")
BJPC2P30
"FIA",9000010.07)
V POV
"FIA",9000010.07,0)
^AUPNVPOV(
"FIA",9000010.07,0,0)
9000010.07P
"FIA",9000010.07,0,1)
y^y^p^^^^n^^n
"FIA",9000010.07,0,10)

"FIA",9000010.07,0,11)

"FIA",9000010.07,0,"RLRO")

"FIA",9000010.07,0,"VR")
2.0^BJPC
"FIA",9000010.07,9000010.07)
1
"FIA",9000010.07,9000010.07,1107)

"FIA",9000010.07,9000010.07,1108)

"FIA",9000011)
PROBLEM
"FIA",9000011,0)
^AUPNPROB(
"FIA",9000011,0,0)
9000011IP
"FIA",9000011,0,1)
y^y^p^^^^n^^n
"FIA",9000011,0,10)

"FIA",9000011,0,11)

"FIA",9000011,0,"RLRO")

"FIA",9000011,0,"VR")
2.0^BJPC
"FIA",9000011,9000011)
1
"FIA",9000011,9000011,.24)

"FIA",9000011,9000011,3.01)

"FIA",9000017)
REPRODUCTIVE FACTORS
"FIA",9000017,0)
^AUPNREP(
"FIA",9000017,0,0)
9000017AP
"FIA",9000017,0,1)
y^y^p^^^^n^^n
"FIA",9000017,0,10)

"FIA",9000017,0,11)

"FIA",9000017,0,"RLRO")

"FIA",9000017,0,"VR")
2.0^BJPC
"FIA",9000017,9000017)
1
"FIA",9000017,9000017,1101)

"FIA",9000024)
BIRTH MEASUREMENT
"FIA",9000024,0)
^AUPNBMSR(
"FIA",9000024,0,0)
9000024A
"FIA",9000024,0,1)
y^y^p^^^^n^^n
"FIA",9000024,0,10)

"FIA",9000024,0,11)

"FIA",9000024,0,"RLRO")

"FIA",9000024,0,"VR")
2.0^BJPC
"FIA",9000024,9000024)
1
"FIA",9000024,9000024,.23)

"INI")
PRE^BJPC2P30
"INIT")
POST^BJPC2P30
"KRN",.402,1719,-1)
0^1
"KRN",.402,1719,0)
APCD BM (BM)^3101217.0811^M^9000001^^@^3250108
"KRN",.402,1719,"DR",1,9000001)
D BM^APCDBMSR;
"KRN",.402,2535,-1)
0^2
"KRN",.402,2535,0)
APCD BM EDIT^3241211.1205^@^9000024^^@^3250108
"KRN",.402,2535,"DR",1,9000024)
W !!,"Patient Name: ",$P(^DPT(DA,0),U);.02:.09;W !!,"When entering Birth Length, use the following format:";W !?5," - to enter the value in inches, just enter the # of inches";
"KRN",.402,2535,"DR",1,9000024,1)
W !?5," - to enter the value in centimeters type a C and the value, e.g. C55";S APCDTBL=$P(^AUPNBMSR(DA,0),U,22);S APCDTBL=$J(APCDTBL,5,2);.22;.23;.11;
"MBREQ")
0
"ORD",7,.402)
.402;7;;;EDEOUT^DIFROMSO(.402,DA,"",XPDA);FPRE^DIFROMSI(.402,"",XPDA);EPRE^DIFROMSI(.402,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.402,DA,"",XPDA);DEL^DIFROMSK(.402,"",%)
"ORD",7,.402,0)
INPUT TEMPLATE
"PKG",393,-1)
1^1
"PKG",393,0)
IHS PCC SUITE^BJPC^IHS PCC SUITE
"PKG",393,20,0)
^9.402P^^
"PKG",393,22,0)
^9.49I^1^1
"PKG",393,22,1,0)
2.0^3090514^3090625^1
"PKG",393,22,1,"PAH",1,0)
30^3250130
"PRE")
BJPC2P30
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
2
"RTN","APCHS7")
0^5^B96243259
"RTN","APCHS7",1,0)
APCHS7 ; IHS/CMI/LAB - PART 7 OF APCHS -- SUMMARY PRODUCTION COMPONENTS ; 09 Aug 2010  10:17 AM
"RTN","APCHS7",2,0)
 ;;2.0;IHS PCC SUITE;**2,5,30**;MAY 14, 2009;Build 7
"RTN","APCHS7",3,0)
 ;
"RTN","APCHS7",4,0)
 ;
"RTN","APCHS7",5,0)
MEDSCURR ; ************** CURRENT MEDICATIONS * 9000010.14 ********
"RTN","APCHS7",6,0)
 S APCHSMTY="CURR" G CONT
"RTN","APCHS7",7,0)
MEDSALL ; **************** ALL MEDICATIONS * 9000010.14 **********
"RTN","APCHS7",8,0)
 S APCHSMTY="ALL" G CONT
"RTN","APCHS7",9,0)
MEDSCHRN ; ************* CHRONIC MEDCICATIONS ************
"RTN","APCHS7",10,0)
 S APCHSMTY="CHRONIC" G CONT
"RTN","APCHS7",11,0)
MEDSNDUP ; ************* ALL, NON DUPLICATED *************
"RTN","APCHS7",12,0)
 S APCHSMTY="NODUP" G CONT
"RTN","APCHS7",13,0)
MEDSCHR1 ; ******* CHRONIC MEDICATIONS, W/O D/C'ED *******
"RTN","APCHS7",14,0)
 S APCHSMTY="CHRONIC",APCHSDCP=1 G CONT
"RTN","APCHS7",15,0)
 ;
"RTN","APCHS7",16,0)
CONT ; <SETUP>
"RTN","APCHS7",17,0)
 ;Q:'$D(^AUPNVMED("AC",APCHSPAT))
"RTN","APCHS7",18,0)
 X APCHSCKP Q:$D(APCHSQIT)  I 'APCHSNPG W ! X APCHSBRK
"RTN","APCHS7",19,0)
 ; <BUILD>
"RTN","APCHS7",20,0)
 K ^TMP($J,"APCHSMTB"),^TMP($J,"APCHSMTP")
"RTN","APCHS7",21,0)
 S APCHSIVD=0 F APCHSQ=0:0 S APCHSIVD=$O(^AUPNVMED("AA",APCHSPAT,APCHSIVD)) Q:APCHSIVD=""!(APCHSIVD>APCHSDLM)  S APCHSMX=0 F APCHSQ=0:0 S APCHSMX=$O(^AUPNVMED("AA",APCHSPAT,APCHSIVD,APCHSMX)) Q:APCHSMX=""  D MEDBLD
"RTN","APCHS7",22,0)
 D NONVA  ;get all NON-VA meds that didn't pass to PCC
"RTN","APCHS7",23,0)
 ; <DISPLAY>
"RTN","APCHS7",24,0)
 S APCHSIVD=0 F APCHSQ=0:0 S APCHSIVD=$O(^TMP($J,"APCHSMTP",APCHSIVD)) Q:'APCHSIVD  D MEDDSP
"RTN","APCHS7",25,0)
 ; <CLEANUP>
"RTN","APCHS7",26,0)
 ;now display all meds on hold
"RTN","APCHS7",27,0)
 D HOLDDSP
"RTN","APCHS7",28,0)
 ;now display MED refusals
"RTN","APCHS7",29,0)
 S APCHST="MEDICATION",APCHSFN=50 D DISPREF^APCHS3C
"RTN","APCHS7",30,0)
 D MEDRU  ;display last date reviewed/updated/nam
"RTN","APCHS7",31,0)
 K APCHST,APCHSFN
"RTN","APCHS7",32,0)
MEDX K APCHSIVD,APCHSMX,APCHSMFX,APCHSQTY,APCHSIG,APCHSSGY,APCHSEXP,APCHSMTS,APCHSMED,APCHSDTM,APCHSDAT,APCHSDYS,APCHSN,APCHSDC,APCHSVDF,APCHSP,APCHORTS,APCHSDCP
"RTN","APCHS7",33,0)
 K APCHSNFL,APCHSNSH,APCHSNAB,APCHSVSC,APCHSITE,APCHSRX,APCHSDRG,APCHSCRN,APCHSREF,APCHSRFL,APCHSALL,APCHSTXT,APCHSMTY
"RTN","APCHS7",34,0)
 K ^TMP($J,"APCHSMTB"),^TMP($J,"APCHSMTP")
"RTN","APCHS7",35,0)
 K X1,X2,X,Y
"RTN","APCHS7",36,0)
 Q
"RTN","APCHS7",37,0)
MEDBLD ;BUILD ARRAY OF MEDICATIONS 
"RTN","APCHS7",38,0)
 ;APCHSDC=DATE DISCONTINUED,DYS=DAYS PRESCRIBED,SIG=DIRECTIONS
"RTN","APCHS7",39,0)
 ;VDF=VISIT FILE DATE
"RTN","APCHS7",40,0)
 ;Q:$P($G(^AUPNVMED(APCHSMX,11)),U,8)]""  ;WILL GET NON-VA MEDS LATER
"RTN","APCHS7",41,0)
 Q:'$D(^AUPNVMED(APCHSMX,0))
"RTN","APCHS7",42,0)
 S APCHSN=^AUPNVMED(APCHSMX,0)
"RTN","APCHS7",43,0)
 Q:'$D(^PSDRUG($P(APCHSN,U,1)))
"RTN","APCHS7",44,0)
 S APCHSDTM=-APCHSIVD\1+9999999
"RTN","APCHS7",45,0)
 ;S APCHSDC=$P(APCHSN,U,8),APCHSDYS=$P(APCHSN,U,7),APCHSMFX=+APCHSN
"RTN","APCHS7",46,0)
 S APCHSDC=$P(APCHSN,U,8),APCHSDYS=$P(APCHSN,U,7),APCHSMFX=$S($P(APCHSN,U,4)="":+APCHSN,1:$P(APCHSN,U,4))
"RTN","APCHS7",47,0)
 S APCHSCMT=$P($G(^AUPNVMED(APCHSMX,11)),U,1)
"RTN","APCHS7",48,0)
 ;I $D(^TMP($J,"APCHSMTB",APCHSMFX)),^TMP($J,"APCHSMTB",APCHSMFX)="" Q
"RTN","APCHS7",49,0)
 S:APCHSDYS="" APCHSDYS=30
"RTN","APCHS7",50,0)
 ;SCREENS OUT MEDS NOT CURRENT; APCHSALL FORCES INCLUSION OF ALL MEDS
"RTN","APCHS7",51,0)
 ;I 'APCHSALL S X1=DT,X2=APCHSDTM D ^%DTC Q:X>60&(X>(2*APCHSDYS))
"RTN","APCHS7",52,0)
 ;S ^TMP($J,"APCHSMTB",APCHSMFX)=APCHSDC,^TMP($J,"APCHSMTP",APCHSIVD_"-"_APCHSMFX)=APCHSMX
"RTN","APCHS7",53,0)
 D @APCHSMTY
"RTN","APCHS7",54,0)
 Q
"RTN","APCHS7",55,0)
NONVA ;EP - ;NEW DFN,PSOACT S DFN=APCHSPAT,PSOACT=1 D ^PSOHCSUM
"RTN","APCHS7",56,0)
 ;quit if chronic
"RTN","APCHS7",57,0)
 Q:APCHSMTY="CHRONIC"
"RTN","APCHS7",58,0)
 S X=0 F  S X=$O(^PS(55,APCHSPAT,"NVA",X)) Q:X'=+X  D
"RTN","APCHS7",59,0)
 .I $P($G(^PS(55,APCHSPAT,"NVA",X,999999911)),U,1),$D(^AUPNVMED($P(^PS(55,APCHSPAT,"NVA",X,999999911),U,1),0)) Q
"RTN","APCHS7",60,0)
 .;S L=$P(^PS(55,APCHSPAT,"NVA",X,0),U,9)
"RTN","APCHS7",61,0)
 .;:'L
"RTN","APCHS7",62,0)
 .S L=$P($P($G(^PS(55,APCHSPAT,"NVA",X,0)),U,10),".")
"RTN","APCHS7",63,0)
 .S L=9999999-L
"RTN","APCHS7",64,0)
 .Q:L>APCHSDLM
"RTN","APCHS7",65,0)
 .;S M=$P($G(^PS(55,APCHSPAT,"NVA",X,999999911)),U,1)  ;passed to PCC so got it already
"RTN","APCHS7",66,0)
 .;I M,$D(^AUPNVMED(M)) Q  ;passed to PCC and v med exists so we already got it from V MED
"RTN","APCHS7",67,0)
 .S D=$P(^PS(55,APCHSPAT,"NVA",X,0),U,2)
"RTN","APCHS7",68,0)
 .I D="" S D="NO DRUG IEN"
"RTN","APCHS7",69,0)
 .S N=$S(D:$P(^PSDRUG(D,0),U,1),1:$P(^PS(50.7,$P(^PS(55,APCHSPAT,"NVA",X,0),U,1),0),U,1))
"RTN","APCHS7",70,0)
 .S ^TMP($J,"APCHSMTP",L_"-"_N)=U_$P(^PS(55,APCHSPAT,"NVA",X,0),U,6)_U_N_U_$P(^PS(55,APCHSPAT,"NVA",X,0),U,4)_" "_$P(^PS(55,APCHSPAT,"NVA",X,0),U,5)_U_$P(^PS(55,APCHSPAT,"NVA",X,0),U,7)
"RTN","APCHS7",71,0)
 .S ^TMP($J,"APCHSMTB",N)=$P(^PS(55,APCHSPAT,"NVA",X,0),U,6)
"RTN","APCHS7",72,0)
 Q
"RTN","APCHS7",73,0)
 ;
"RTN","APCHS7",74,0)
CURR ; current meds only
"RTN","APCHS7",75,0)
 I $D(^TMP($J,"APCHSMTB",APCHSMFX)),^TMP($J,"APCHSMTB",APCHSMFX)="" Q  ;ALREADY GOT THIS MED
"RTN","APCHS7",76,0)
 S X1=DT,X2=APCHSDTM D ^%DTC Q:X>60&(X>(2*APCHSDYS))
"RTN","APCHS7",77,0)
 S ^TMP($J,"APCHSMTB",APCHSMFX)=APCHSDC,^TMP($J,"APCHSMTP",APCHSIVD_"-"_APCHSMFX)=APCHSMX
"RTN","APCHS7",78,0)
 Q
"RTN","APCHS7",79,0)
ALL ;all meds included
"RTN","APCHS7",80,0)
 S ^TMP($J,"APCHSMTB",APCHSMFX)=APCHSDC,^TMP($J,"APCHSMTP",APCHSIVD_"-"_APCHSMFX)=APCHSMX
"RTN","APCHS7",81,0)
 ;now get NVA meds
"RTN","APCHS7",82,0)
 Q
"RTN","APCHS7",83,0)
NODUP ;
"RTN","APCHS7",84,0)
 ;I $D(^TMP($J,"APCHSMTB",APCHSMFX)) Q
"RTN","APCHS7",85,0)
 ;S X="" F  S X=$O(^TMP($J,"APCHSMTP",X)) Q:X=""  I $P(X,"-",2)=APCHSMFX K ^TMP($J,"APCHSMTP",X)
"RTN","APCHS7",86,0)
 I $D(^TMP($J,"APCHSMTP",APCHSIVD_"-"_APCHSMFX)) S ^TMP($J,"APCHSMTP",APCHSIVD_"-"_APCHSMFX)=APCHSMX
"RTN","APCHS7",87,0)
 I $D(^TMP($J,"APCHSMTB",APCHSMFX)) Q
"RTN","APCHS7",88,0)
 S ^TMP($J,"APCHSMTB",APCHSMFX)=APCHSDC,^TMP($J,"APCHSMTP",APCHSIVD_"-"_APCHSMFX)=APCHSMX
"RTN","APCHS7",89,0)
 Q
"RTN","APCHS7",90,0)
CHRONIC ;chronic meds only
"RTN","APCHS7",91,0)
 I $D(^TMP($J,"APCHSMTB",APCHSMFX)) Q
"RTN","APCHS7",92,0)
 S X=$S($D(^PSRX("APCC",APCHSMX)):$O(^(APCHSMX,0)),1:0)
"RTN","APCHS7",93,0)
 S Y=$S(+X:$D(^PS(55,APCHSPAT,"P","CP",X)),1:0)
"RTN","APCHS7",94,0)
 Q:'Y
"RTN","APCHS7",95,0)
 I $G(APCHSDCP),APCHSDC]"",APCHSCMT'="RETURNED TO STOCK" Q  ;IHS/CMI/LAB - new component patch 9
"RTN","APCHS7",96,0)
 S ^TMP($J,"APCHSMTB",APCHSMFX)=APCHSDC,^TMP($J,"APCHSMTP",APCHSIVD_"-"_APCHSMFX)=APCHSMX
"RTN","APCHS7",97,0)
 Q
"RTN","APCHS7",98,0)
MEDDSP ;DISPLAY MEDICATION
"RTN","APCHS7",99,0)
 ;APCHSRX=RX# in FILE 52,CHRN=CHRONIC FLAG,REF=#REFILLS
"RTN","APCHS7",100,0)
 S APCHSMX=^TMP($J,"APCHSMTP",APCHSIVD)
"RTN","APCHS7",101,0)
 I $P(APCHSMX,U,1)="" D NVADSP Q
"RTN","APCHS7",102,0)
 S APCHSN=^AUPNVMED(APCHSMX,0)
"RTN","APCHS7",103,0)
 S APCHSRX=$S($D(^PSRX("APCC",APCHSMX)):$O(^(APCHSMX,0)),1:0)
"RTN","APCHS7",104,0)
 S APCHSCRN=$S(+APCHSRX:$D(^PS(55,APCHSPAT,"P","CP",APCHSRX)),1:0)
"RTN","APCHS7",105,0)
 S (Y,APCHSDTM)=-APCHSIVD\1+9999999 X APCHSCVD S APCHSDAT=Y
"RTN","APCHS7",106,0)
 S APCHSDC=$P(APCHSN,U,8),APCHSDYS=$P(APCHSN,U,7),APCHSQTY=$P(APCHSN,U,6),APCHSIG=$P(APCHSN,U,5),APCHSVDF=$P(APCHSN,U,3),APCHSMFX=+APCHSN
"RTN","APCHS7",107,0)
 S:APCHSDYS="" APCHSDYS=30
"RTN","APCHS7",108,0)
 S X1=DT,X2=APCHSDTM D ^%DTC ;Q:X>60&(X>(2*APCHSDYS))
"RTN","APCHS7",109,0)
 S APCHSEXP=""
"RTN","APCHS7",110,0)
 I X>APCHSDYS S X1=APCHSDTM,X2=APCHSDYS D C^%DTC S Y=X X APCHSCVD S APCHSEXP="-- Ran out "_Y
"RTN","APCHS7",111,0)
 S APCHSMED=$S($P(APCHSN,U,4)="":$P(^PSDRUG(APCHSMFX,0),U,1),1:$P(APCHSN,U,4))
"RTN","APCHS7",112,0)
 I APCHSDC S Y=APCHSDC X APCHSCVD S APCHSEXP="-- D/C "_Y
"RTN","APCHS7",113,0)
 ;CHANGE IT AROUND A BIT LOOK FOR RETURNED TO STOCK IHS/OKCAO/POC 2/14/2000
"RTN","APCHS7",114,0)
 S APCHORTS=$G(^AUPNVMED(APCHSMX,11))
"RTN","APCHS7",115,0)
 I APCHORTS["RETURNED TO STOCK",APCHSDC S APCHSEXP="--RTS "_Y
"RTN","APCHS7",116,0)
 ;END OF LOCAL CHANGES IHS/OKCAO/POC 2/14/2000
"RTN","APCHS7",117,0)
 D SIG S APCHSIG=APCHSSGY
"RTN","APCHS7",118,0)
 D REF I APCHSREF S APCHSIG=APCHSIG_" "_APCHSREF_$S(APCHSREF=1:" refill",1:" refills")_" left."
"RTN","APCHS7",119,0)
 I '$P($G(^AUPNVMED(APCHSMX,11)),U,8) S V=$P(^AUPNVMED(APCHSMX,0),U,3) I $P($G(^AUPNVSIT(+V,0)),U,7)="E" S APCHSIG=APCHSIG_"  (OUTSIDE MEDICATION)"
"RTN","APCHS7",120,0)
 I $P($G(^AUPNVMED(APCHSMX,11)),U,8) S APCHSIG=APCHSIG_"  (EHR OUTSIDE MEDICATION)"
"RTN","APCHS7",121,0)
 D SITE ;I APCHSITE]"" S APCHSIG=APCHSIG_"  ["_APCHSITE_"]"
"RTN","APCHS7",122,0)
 X APCHSCKP Q:$D(APCHSQIT)
"RTN","APCHS7",123,0)
 W APCHSDAT,?10,$S(APCHSCRN:"(C)",1:""),?14,APCHSMED," #",APCHSQTY," (",APCHSDYS," days) ",APCHSEXP,!
"RTN","APCHS7",124,0)
 I APCHSITE]"" W ?14,"Dispensed at: ",APCHSITE,!
"RTN","APCHS7",125,0)
 X APCHSCKP Q:$D(APCHSQIT)
"RTN","APCHS7",126,0)
 S APCHSICL=14,APCHSNRQ="",APCHSTXT=APCHSIG D PRTTXT^APCHSUTL K APCHSICL,APCHSNRQ,APCHSP
"RTN","APCHS7",127,0)
 Q
"RTN","APCHS7",128,0)
NVADSP ;
"RTN","APCHS7",129,0)
 S APCHSEXP=""
"RTN","APCHS7",130,0)
 S (Y,APCHSDTM)=-APCHSIVD\1+9999999 X APCHSCVD S APCHSDAT=Y
"RTN","APCHS7",131,0)
 S APCHSDC=$P(^TMP($J,"APCHSMTP",APCHSIVD),U,5)
"RTN","APCHS7",132,0)
 S APCHSMED=$P(^TMP($J,"APCHSMTP",APCHSIVD),U,3)
"RTN","APCHS7",133,0)
 I APCHSDC S Y=APCHSDC X APCHSCVD S APCHSEXP="-- D/C "_Y
"RTN","APCHS7",134,0)
 S APCHSIG=$P(^TMP($J,"APCHSMTP",APCHSIVD),U,4)
"RTN","APCHS7",135,0)
 X APCHSCKP Q:$D(APCHSQIT)
"RTN","APCHS7",136,0)
 W APCHSDAT,?14,APCHSMED,"  ",APCHSEXP,!
"RTN","APCHS7",137,0)
 X APCHSCKP Q:$D(APCHSQIT)
"RTN","APCHS7",138,0)
 S APCHSICL=14,APCHSNRQ="",APCHSTXT=APCHSIG_"  (EHR OUTSIDE MEDICATION)" D PRTTXT^APCHSUTL K APCHSICL,APCHSNRQ,APCHSP
"RTN","APCHS7",139,0)
 Q
"RTN","APCHS7",140,0)
 ;
"RTN","APCHS7",141,0)
SIG ;CONSTRUCT THE FULL TEXT FROM THE ENCODED SIG
"RTN","APCHS7",142,0)
 I $$VALI^XBDIQ1(9001015,APCHSTYP,3.5)="S" S APCHSSGY=APCHSIG Q
"RTN","APCHS7",143,0)
 S APCHSSGY="" F APCHSP=1:1:$L(APCHSIG," ") S X=$P(APCHSIG," ",APCHSP) I X]"" D
"RTN","APCHS7",144,0)
 . S Y=$O(^PS(51,"B",X,0)) I Y>0 S X=$P(^PS(51,Y,0),"^",2) I $D(^(9)) S Y=$P(APCHSIG," ",APCHSP-1),Y=$E(Y,$L(Y)) S:Y>1 X=$P(^(9),"^",1)
"RTN","APCHS7",145,0)
 . S APCHSSGY=APCHSSGY_X_" "
"RTN","APCHS7",146,0)
 Q
"RTN","APCHS7",147,0)
 ;
"RTN","APCHS7",148,0)
REF ;DETERMINE THE NUMBER OF REFILLS REMAINING
"RTN","APCHS7",149,0)
 I 'APCHSRX S APCHSREF=0 Q
"RTN","APCHS7",150,0)
 S APCHSRFL=$P($G(^PSRX(APCHSRX,0)),U,9) S APCHSREF=0 F  S APCHSREF=$O(^PSRX(APCHSRX,1,APCHSREF)) Q:'APCHSREF  S APCHSRFL=APCHSRFL-1
"RTN","APCHS7",151,0)
 S APCHSREF=APCHSRFL
"RTN","APCHS7",152,0)
 Q
"RTN","APCHS7",153,0)
 ;
"RTN","APCHS7",154,0)
SITE ;DETERMINE IF OUTSIDE LOCATION INFO PRESENT
"RTN","APCHS7",155,0)
 S APCHSITE=""
"RTN","APCHS7",156,0)
 I $D(^AUPNVSIT(APCHSVDF,21))#2 S APCHSITE=$P(^(21),U) Q
"RTN","APCHS7",157,0)
 Q:$P($G(^AUPNVSIT(APCHSVDF,0)),U,6)=""
"RTN","APCHS7",158,0)
 I $P(^AUPNVSIT(APCHSVDF,0),U,6)'=DUZ(2) S APCHSITE=$E($P(^DIC(4,$P(^AUPNVSIT(APCHSVDF,0),U,6),0),U),1,30)
"RTN","APCHS7",159,0)
 Q
"RTN","APCHS7",160,0)
 ;
"RTN","APCHS7",161,0)
HOLDMEDS(P,R) ;EP - get meds on hold for display
"RTN","APCHS7",162,0)
 ;return array of med iens of all meds for this patient that are on hold
"RTN","APCHS7",163,0)
 I '$G(P) Q
"RTN","APCHS7",164,0)
 NEW D,C,N
"RTN","APCHS7",165,0)
 S D=DT
"RTN","APCHS7",166,0)
 F  S D=$O(^PS(55,P,"P","A",D)) Q:D'=+D  D
"RTN","APCHS7",167,0)
 .S N=0 F  S N=$O(^PS(55,P,"P","A",D,N)) Q:'N  D
"RTN","APCHS7",168,0)
 ..Q:'$$HOLD(N)
"RTN","APCHS7",169,0)
 ..S R(N)=""
"RTN","APCHS7",170,0)
 ..Q
"RTN","APCHS7",171,0)
 Q
"RTN","APCHS7",172,0)
 ;
"RTN","APCHS7",173,0)
HOLD(S) ;EP - is this prescription on hold?
"RTN","APCHS7",174,0)
 NEW X
"RTN","APCHS7",175,0)
 S X=$P($G(^PSRX(S,"STA")),U,1)
"RTN","APCHS7",176,0)
 I X=3 Q 1
"RTN","APCHS7",177,0)
 I X=5 Q 1
"RTN","APCHS7",178,0)
 I X=16 Q 1
"RTN","APCHS7",179,0)
 ;version 6
"RTN","APCHS7",180,0)
 S X=$P($G(^PSRX(S,0)),U,15)
"RTN","APCHS7",181,0)
 I X=3 Q 1
"RTN","APCHS7",182,0)
 I X=5 Q 1
"RTN","APCHS7",183,0)
 I X=16 Q 1
"RTN","APCHS7",184,0)
 Q 0
"RTN","APCHS7",185,0)
 ;
"RTN","APCHS7",186,0)
HOLDDSP ;EP - display all meds on hold
"RTN","APCHS7",187,0)
 K APCHHMED
"RTN","APCHS7",188,0)
 D HOLDMEDS(APCHSPAT,.APCHHMED)
"RTN","APCHS7",189,0)
 Q:'$D(APCHHMED)
"RTN","APCHS7",190,0)
 X APCHSCKP Q:$D(APCHSQIT)
"RTN","APCHS7",191,0)
 W !,"The following medications have been processed in the Pharmacy "
"RTN","APCHS7",192,0)
 W !,"system, and are currently active but not dispensed:",!,!
"RTN","APCHS7",193,0)
 S APCHSRX=0 F  S APCHSRX=$O(APCHHMED(APCHSRX)) Q:APCHSRX'=+APCHSRX!($D(APCHSQIT))  D
"RTN","APCHS7",194,0)
 .D HOLDDSP1
"RTN","APCHS7",195,0)
 .Q
"RTN","APCHS7",196,0)
 X APCHSCKP Q:$D(APCHSQIT)
"RTN","APCHS7",197,0)
 W !,"Medications may be active but not dispensed for several reasons including: "
"RTN","APCHS7",198,0)
 X APCHSCKP Q:$D(APCHSQIT)
"RTN","APCHS7",199,0)
 W !,"Too early for refill, patient has sufficient amount on hand, pharmacy"
"RTN","APCHS7",200,0)
 X APCHSCKP Q:$D(APCHSQIT)
"RTN","APCHS7",201,0)
 W !,"resolving issue with prescriber, etc. Contact Pharmacy staff for "
"RTN","APCHS7",202,0)
 X APCHSCKP Q:$D(APCHSQIT)
"RTN","APCHS7",203,0)
 W !,"details or view prescription details in Pharmacy system.",!
"RTN","APCHS7",204,0)
 K APCHHMED
"RTN","APCHS7",205,0)
 Q
"RTN","APCHS7",206,0)
HOLDDSP1 ;write out med
"RTN","APCHS7",207,0)
 S APCHSCRN=$S(+APCHSRX:$D(^PS(55,APCHSPAT,"P","CP",APCHSRX)),1:0)
"RTN","APCHS7",208,0)
 S (Y,APCHSDTM)=$P(^PSRX(APCHSRX,0),U,13) X APCHSCVD S APCHSDAT=Y  ;issue or fill??
"RTN","APCHS7",209,0)
 S APCHSDYS=$P(^PSRX(APCHSRX,0),U,8)
"RTN","APCHS7",210,0)
 S APCHSQTY=$P(^PSRX(APCHSRX,0),U,7)
"RTN","APCHS7",211,0)
 S APCHSIG=$P(^PSRX(APCHSRX,0),U,10)
"RTN","APCHS7",212,0)
 D SIG S APCHSIG=APCHSSGY
"RTN","APCHS7",213,0)
 D REF I APCHSREF S APCHSIG=APCHSIG_" "_APCHSREF_$S(APCHSREF=1:" refill",1:" refills")_" left."
"RTN","APCHS7",214,0)
 ;D SITE ;I APCHSITE]"" S APCHSIG=APCHSIG_"  ["_APCHSITE_"]"
"RTN","APCHS7",215,0)
 X APCHSCKP Q:$D(APCHSQIT)
"RTN","APCHS7",216,0)
 W APCHSDAT,?10,$S(APCHSCRN:"(C)",1:""),?14,$$VAL^XBDIQ1(52,APCHSRX,6)," #",APCHSQTY," (",APCHSDYS," days) ",!
"RTN","APCHS7",217,0)
 ;I APCHSITE]"" W ?14,"Dispensed at: ",APCHSITE,!
"RTN","APCHS7",218,0)
 X APCHSCKP Q:$D(APCHSQIT)
"RTN","APCHS7",219,0)
 S APCHSICL=14,APCHSNRQ="",APCHSTXT=APCHSIG D PRTTXT^APCHSUTL K APCHSICL,APCHSNRQ,APCHSP
"RTN","APCHS7",220,0)
 W ?14,"Ordering Provider: ",$$VAL^XBDIQ1(52,APCHSRX,4),!
"RTN","APCHS7",221,0)
 X APCHSCKP Q:$D(APCHSQIT)
"RTN","APCHS7",222,0)
 ;S %=$$VAL^XBDIQ1(52,APCHSRX,100) S APCHSTXT=$S(%["HOLD":"Active/See Details: ",1:%_" Reason: "),APCHSICL=14,APCHSNRQ=""
"RTN","APCHS7",223,0)
 S %=$$VAL^XBDIQ1(52,APCHSRX,100) S T="Active/See Details: "
"RTN","APCHS7",224,0)
 ;S APCHSTXT=$$VAL^XBDIQ1(52,APCHSRX,100)_" Reason: "_$$VAL^XBDIQ1(52,APCHSRX,99)_" - "_$$VAL^XBDIQ1(52,APCHSRX,99.1)_" ("_$$VAL^XBDIQ1(52,APCHSRX,99.2)_")",APCHSICL=14,APCHSNRQ=""
"RTN","APCHS7",225,0)
 S APCHSTXT=T_$$VAL^XBDIQ1(52,APCHSRX,99)_" - "_$$VAL^XBDIQ1(52,APCHSRX,99.1)_" ("_$$VAL^XBDIQ1(52,APCHSRX,99.2)_")",APCHSICL=14,APCHSNRQ=""
"RTN","APCHS7",226,0)
 D PRTTXT^APCHSUTL K APCHSICL,APCHSNRQ,APCHSP
"RTN","APCHS7",227,0)
 Q
"RTN","APCHS7",228,0)
MEDRU ;EP
"RTN","APCHS7",229,0)
 ;get date last reviewed and display
"RTN","APCHS7",230,0)
 S APCHSX=$$LASTMLR^APCLAPI6(APCHSPAT,,DT,"A")
"RTN","APCHS7",231,0)
 X APCHSCKP Q:$D(APCHSQIT)
"RTN","APCHS7",232,0)
 W !,"Medication List Reviewed On: ",?36,$$FMTE^XLFDT($P(APCHSX,U,1)) W ?51,"By: ",?56,$E($S($P(APCHSX,U,3):$P($G(^VA(200,$P(APCHSX,U,3),0)),U),1:""),1,22),!
"RTN","APCHS7",233,0)
 S APCHSX=$$LASTMLU^APCLAPI6(APCHSPAT,,DT,"A")
"RTN","APCHS7",234,0)
 X APCHSCKP Q:$D(APCHSQIT)
"RTN","APCHS7",235,0)
 W "Medication List Updated On: ",?36,$$FMTE^XLFDT($P(APCHSX,U,1)) W ?51,"By: ",?56,$E($S($P(APCHSX,U,3):$P($G(^VA(200,$P(APCHSX,U,3),0)),U),1:""),1,22),!
"RTN","APCHS7",236,0)
 S APCHSX=$$LASTNAM^APCLAPI6(APCHSPAT,,DT,"A")
"RTN","APCHS7",237,0)
 X APCHSCKP Q:$D(APCHSQIT)
"RTN","APCHS7",238,0)
 ;I '$$ANYACTP^APCDAPRB(APCHSPAT) W !,"No Active Problems: ",?24,$$FMTE^XLFDT($P(APCHSX,U,1)) I $P(APCHSX,U,3) W ?39,"Documented By: ",?54,$E($P($G(^VA(200,$P(APCHSX,U,3),0)),U),1,25),!
"RTN","APCHS7",239,0)
 W "No Active Medications Documented On: ",?36,$$FMTE^XLFDT($P(APCHSX,U,1)) W ?51,"By: ",?56,$E($S($P(APCHSX,U,3):$P($G(^VA(200,$P(APCHSX,U,3),0)),U),1:""),1,22),!
"RTN","APCHS7",240,0)
 Q
"RTN","BJPC2P30")
0^^B8233875
"RTN","BJPC2P30",1,0)
BJPC2P30 ; IHS/CMI/LAB - PCC Suite v2.0 PATCH 30 PRE/POST INIT
"RTN","BJPC2P30",2,0)
 ;;2.0;IHS PCC SUITE;**30**;MAY 14, 2009;Build 7
"RTN","BJPC2P30",3,0)
 ;
"RTN","BJPC2P30",4,0)
 ;
"RTN","BJPC2P30",5,0)
 ; The following line prevents the "Disable Options..." and "Move Routines..." questions from being asked during the install.
"RTN","BJPC2P30",6,0)
 I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
"RTN","BJPC2P30",7,0)
 F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
"RTN","BJPC2P30",8,0)
 ;KERNEL
"RTN","BJPC2P30",9,0)
 I '$$INSTALLD("XU*8.0*1018") D SORRY(2)
"RTN","BJPC2P30",10,0)
 I '$$INSTALLD("DI*22.0*1018") D SORRY(2)
"RTN","BJPC2P30",11,0)
 I '$$INSTALLD("BJPC*2.0*29") D MES^XPDUTL($$CJ^XLFSTR("Requires BJPC V2.0 patch 29.  Not installed.",80)) D SORRY(2)
"RTN","BJPC2P30",12,0)
 ;I '$$INSTALLD("ADE*6.0*42") D MES^XPDUTL($$CJ^XLFSTR("Requires ADE V6.0 patch 42.  Not installed.",80)) D SORRY(2)   ;SAVE FOR PATCH 31
"RTN","BJPC2P30",13,0)
 ;ADD ADE PATCH NUMBER FOR ADA CODE UPDATES
"RTN","BJPC2P30",14,0)
 Q
"RTN","BJPC2P30",15,0)
 ;
"RTN","BJPC2P30",16,0)
PRE ;
"RTN","BJPC2P30",17,0)
 Q
"RTN","BJPC2P30",18,0)
POST ;
"RTN","BJPC2P30",19,0)
 ;D ADATAX   -SAVE FOR PATCH 31
"RTN","BJPC2P30",20,0)
 ;
"RTN","BJPC2P30",21,0)
 Q
"RTN","BJPC2P30",22,0)
ADATAX ;
"RTN","BJPC2P30",23,0)
 S ATXFLG=1
"RTN","BJPC2P30",24,0)
 S BGPDA=0 S BGPDA=$O(^ATXAX("B","BJPC DENTAL EXAM ADA CODES",BGPDA))
"RTN","BJPC2P30",25,0)
 I BGPDA S DIK="^ATXAX(",DA=BGPDA D ^DIK  ;get rid of existing one
"RTN","BJPC2P30",26,0)
 W !,"Creating/Updating BJPC DENTAL EXAM ADA CODESTaxonomy..."
"RTN","BJPC2P30",27,0)
 S X="BJPC DENTAL EXAM ADA CODES",DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DIADD,DLAYGO,I
"RTN","BJPC2P30",28,0)
 I Y=-1 W !!,"ERROR IN CREATING BJPC DENTAL EXAM ADA CODES" Q
"RTN","BJPC2P30",29,0)
 S BGPTX=+Y,$P(^ATXAX(BGPTX,0),U,2)="BGP IPC BMI ADA CODES",$P(^(0),U,5)=DUZ,$P(^(0),U,8)=0,$P(^(0),U,9)=DT,$P(^(0),U,12)=174,$P(^(0),U,13)=0,$P(^(0),U,15)=9999999.31,^ATXAX(BGPTX,21,0)="^9002226.02101A^0^0"
"RTN","BJPC2P30",30,0)
 S BGPX=0
"RTN","BJPC2P30",31,0)
 F X="0120","0140","0145","0150","0160","0180","0191","D0120","D0140","D0145","D0150","D0160","D0180","D0191" S DIC="^AUTTADA(",DIC(0)="M" D ^DIC K DIC,DA,DR,DIADD,DLAYGO,DQ,DI,D1,D0 I $P(Y,U)>0 D
"RTN","BJPC2P30",32,0)
 .S BGPX=BGPX+1
"RTN","BJPC2P30",33,0)
 .S ^ATXAX(BGPTX,21,BGPX,0)=+Y,$P(^ATXAX(BGPTX,21,0),U,3)=BGPX,$P(^(0),U,4)=BGPX,^ATXAX(BGPTX,21,"AA",+Y,BGPX)=""
"RTN","BJPC2P30",34,0)
 .Q
"RTN","BJPC2P30",35,0)
 S DA=BGPTX,DIK="^ATXAX(" D IX1^DIK
"RTN","BJPC2P30",36,0)
 Q
"RTN","BJPC2P30",37,0)
INSTALLD(BJPCSTAL) ;EP - Determine if patch BJPCSTAL was installed, where
"RTN","BJPC2P30",38,0)
 ; APCLSTAL is the name of the INSTALL.  E.g "AG*6.0*11".
"RTN","BJPC2P30",39,0)
 ;
"RTN","BJPC2P30",40,0)
 NEW BJPCY,DIC,X,Y
"RTN","BJPC2P30",41,0)
 S X=$P(BJPCSTAL,"*",1)
"RTN","BJPC2P30",42,0)
 S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
"RTN","BJPC2P30",43,0)
 D IX^DIC
"RTN","BJPC2P30",44,0)
 I Y<1 D IMES Q 0
"RTN","BJPC2P30",45,0)
 S DIC=DIC_+Y_",22,",X=$P(BJPCSTAL,"*",2)
"RTN","BJPC2P30",46,0)
 D ^DIC
"RTN","BJPC2P30",47,0)
 I Y<1 D IMES Q 0
"RTN","BJPC2P30",48,0)
 S DIC=DIC_+Y_",""PAH"",",X=$P(BJPCSTAL,"*",3)
"RTN","BJPC2P30",49,0)
 D ^DIC
"RTN","BJPC2P30",50,0)
 S BJPCY=Y
"RTN","BJPC2P30",51,0)
 D IMES
"RTN","BJPC2P30",52,0)
 Q $S(BJPCY<1:0,1:1)
"RTN","BJPC2P30",53,0)
IMES ;
"RTN","BJPC2P30",54,0)
 D MES^XPDUTL($$CJ^XLFSTR("Patch """_BJPCSTAL_""" is"_$S(Y<1:" *NOT*",1:"")_" installed.",IOM))
"RTN","BJPC2P30",55,0)
 Q
"RTN","BJPC2P30",56,0)
SORRY(X) ;
"RTN","BJPC2P30",57,0)
 KILL DIFQ
"RTN","BJPC2P30",58,0)
 I X=3 S XPDQUIT=2 Q
"RTN","BJPC2P30",59,0)
 S XPDQUIT=X
"RTN","BJPC2P30",60,0)
 Q
"VER")
8.0^22.0
"^DD",9000010.07,9000010.07,1107,0)
DATE OF DIAGNOSIS^D^^11;7^S %DT="E" D ^%DT S X=Y K:Y<1 X
"^DD",9000010.07,9000010.07,1107,"DT")
3250108
"^DD",9000010.07,9000010.07,1108,0)
DATE RESOLVED^D^^11;8^S %DT="E" D ^%DT S X=Y K:Y<1 X
"^DD",9000010.07,9000010.07,1108,3)

"^DD",9000010.07,9000010.07,1108,"DT")
3250108
"^DD",9000011,9000011,.24,0)
DATE OF DIAGNOSIS^D^^0;24^S %DT="E" D ^%DT S X=Y K:Y<1 X
"^DD",9000011,9000011,.24,"DT")
3241211
"^DD",9000011,9000011,3.01,0)
SOURCE OF DATE OF DIAGNOSIS^S^P:Patient;F:Family/Caregiver/Friend;D:Provider;M:External Medical Records/CCDA;C:Chart Review;X:Other Source;^3;1^Q
"^DD",9000011,9000011,3.01,"DT")
3250130
"^DD",9000017,9000017,1101,0)
CURRENTLY PREGNANT^S^Y:YES;N:NO;U:UNKNOWN;R:PT REFUSED TO ANSWER;P:POSSIBLY PREGNANT;^11;1^Q
"^DD",9000017,9000017,1101,1,0)
^.1^^-1
"^DD",9000017,9000017,1101,1,1,0)
^^TRIGGER^9000017^1102
"^DD",9000017,9000017,1101,1,1,1)
K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^AUPNREP(D0,11)):^(11),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X=DIV S X=DT S DIH=$G(^AUPNREP(DIV(0),11)),DIV=X S $P(^(11),U,2)=DIV,DIH=9000017,DIG=1102 D ^DICR
"^DD",9000017,9000017,1101,1,1,2)
K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^AUPNREP(D0,11)):^(11),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X=DIV S X=DT S DIH=$G(^AUPNREP(DIV(0),11)),DIV=X S $P(^(11),U,2)=DIV,DIH=9000017,DIG=1102 D ^DICR
"^DD",9000017,9000017,1101,1,1,"CREATE VALUE")
S X=DT
"^DD",9000017,9000017,1101,1,1,"DELETE VALUE")
S X=DT
"^DD",9000017,9000017,1101,1,1,"FIELD")
#1102
"^DD",9000017,9000017,1101,3)
Is the patient pregnant?
"^DD",9000017,9000017,1101,"AUDIT")
n
"^DD",9000017,9000017,1101,"DT")
3241211
"^DD",9000024,9000024,.23,0)
MULTIPLE BIRTH?^S^1:YES;0:NO;^0;23^Q
"^DD",9000024,9000024,.23,"DT")
3241203
**END**
**END**