- APCHS7R ; IHS/CMI/LAB - PART 7 OF APCHS -- SUMMARY PRODUCTION COMPONENTS ;
- ;;2.0;IHS PCC SUITE;**2,5**;MAY 14, 2009
- ;
- SET ;
- ;S APCHCNT=APCHCNT+1
- S APCHSRX=P,APCHSREF=0 D REF
- S APCHSTAT(C,N,D,(9999999-F),M)=$S(P:$P(^PSRX(P,0),U),1:"")_U_APCHSREF
- S APCHMDSP(D,N,F)=""
- Q
- MEDRCON ; ************* MEDS BY PRESCRIPTION STATUS *************
- ;
- CONT ; <SETUP>
- I '$D(^AUPNVMED("AC",APCHSPAT)),'$D(^PS(52.41,"P",APCHSPAT)),'$D(^PS(55,APCHSPAT,"NVA")) Q
- X APCHSCKP Q:$D(APCHSQIT) I 'APCHSNPG W ! X APCHSBRK
- ; <BUILD>
- NEW APCHMEDS,APCHSTAT,APCHCNT,APCHMDSP,APCHDI,APCHDT,APCHM,APCHN,APCHSSGY,APCHSIG,APCHZ,APCHSN,APCHST,APCHI,APCHD
- NEW X,F,M,V,D,N,P,C,E,S,R,J
- S APCHCNT=0
- K APCHMEDS,APCHMDSP
- D GETMEDS^APCHSMU1(APCHSPAT,$$FMADD^XLFDT(DT,-395),DT,,,,,.APCHMEDS)
- ;I '$D(APCHMEDS) D MEDX Q
- ;NOW REORDER THEM BY STATUS
- K APCHSTAT
- S X=0 F S X=$O(APCHMEDS(X)) Q:X'=+X D
- .S P=""
- .S F=$P(APCHMEDS(X),U,1) ;FILL DATE
- .S M=$P(APCHMEDS(X),U,4) ;vmed ien
- .S V=$P(APCHMEDS(X),U,5) ;visit ien
- .S D=$P(^AUPNVMED(M,0),U) ;drug ien
- .S N=$P(^AUPNVMED(M,0),U,4) ;non table drug name
- .I N="" S N=$P(^PSDRUG(D,0),U) ;drug name
- .I $P($G(^AUPNVSIT(X,0)),U,7)="E" S C="OUTSIDE MEDICATIONS" D SET Q
- .;I $P($G(^AUPNVMED(X,11)),U,8)]"" Q ;we will get EHR outside meds from the NVA multiple later S C="OUTSIDE MEDICATIONS" D SET Q
- .S P=$O(^PSRX("APCC",M,0))
- .I 'P S C="OUTSIDE MEDICATIONS" D SET Q
- .I '$D(^PSRX(P,0)) S P="",C="OUTSIDE MEDICATIONS" D SET Q
- .S S=$$VALI^XBDIQ1(52,P,100) ;GET STATUS
- .I S=0 S C="ACTIVE MEDICATIONS" D SET Q
- .I S=3 S C="HOLD" D SET Q
- .I S=5 S C="SUSPENDED" D SET Q
- .I S=11 D Q
- ..;get expiration date
- ..S E=$P($G(^PSRX(P,3)),U,6)
- ..S R=$$CHRONIC^APCHS72(M) ;chronic flag
- ..I 'R D Q
- ...;not chronic, check to see if expired in past 14 days, if not quit
- ...S J=$$FMDIFF^XLFDT(DT,E)
- ...Q:J>14 ;more than 14 days ago so don't display
- ...;check to see if same drug is already listed somewhere
- ...Q:$O(APCHMDSP(D,N,F)) ;another of same drug after this date
- ...S C="EXPIRED" D SET Q
- ..;chronic = check 120 days
- ..S J=$$FMDIFF^XLFDT(DT,E)
- ..Q:J>120 ;expired more than 120 days ago
- ..Q:$O(APCHMDSP(D,N,F)) ;another one there so don't display this one
- ..S C="EXPIRED" D SET Q
- .I S=12!(S=14) D
- ..S E=$P(^AUPNVMED(M,0),U,8) ;discontinued date in v med
- ..I E="" S E=$P($G(^PSRX(P,3)),U,5) ;canceled date in 52
- ..I $$FMDIFF^XLFDT(DT,E)>30 Q ;only discontinueds in past 30 days
- ..Q:$O(APCHMDSP(D,N,F))
- ..S C="DISCONTINUED MEDICATIONS" D SET Q
- GETNVA ;NVA from file 55
- S X=0 F S X=$O(^PS(55,APCHSPAT,"NVA",X)) Q:X'=+X D
- .I $P($G(^PS(55,APCHSPAT,"NVA",X,999999911)),U,1),$D(^AUPNVMED($P(^PS(55,APCHSPAT,"NVA",X,999999911),U,1),0)) Q ;got this with V MED
- .;S L=$P(^PS(55,APCHSPAT,"NVA",X,0),U,9)
- .;:'L
- .S L=$P($P($G(^PS(55,APCHSPAT,"NVA",X,0)),U,10),".")
- .S L=9999999-L
- .;Q:$P(^PS(55,APCHSPAT,"NVA",X,0),U,6)=1 ;discontinued
- .;I $P(^PS(55,APCHSPAT,"NVA",X,0),U,7)]"" ;discontinued date
- .S D=$P(^PS(55,APCHSPAT,"NVA",X,0),U,2)
- .I D="" S D="NO DRUG IEN"
- .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))
- .S APCHSTAT("NVA",N,D,(9999999-L))=U_"N",$P(APCHSTAT("NVA",N,D,(9999999-L)),U,8)=$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)
- GETPEND ;
- NEW PEN,ORD
- F PEN=0:0 S PEN=$O(^PS(52.41,"P",APCHSPAT,PEN)) Q:'PEN S ORD=^PS(52.41,PEN,0),APCHI=$P(ORD,"^",8),APCHD=+$P(ORD,"^",9) D:$P(ORD,"^",3)'="DC"&($P(ORD,"^",3)'="DE")&($P(ORD,"^",3)'="HD")
- .S APCHN=$S(APCHD:$P($G(^PSDRUG(APCHD,0)),"^"),+APCHI&('APCHD):$P(^PS(50.7,APCHI,0),"^")_" "_$P(^PS(50.606,$P(^PS(50.7,APCHI,0),"^",2),0),"^"),1:"") Q:APCHN']""
- .S APCHSTAT("PENDING",APCHN,PEN)=$$VAL^XBDIQ1(52.41,PEN,13)
- .S C=0,X="" F S C=$O(^PS(52.41,PEN,"SIG",C)) Q:'C S X=X_$S(X]"":" ",1:"")_^PS(52.41,PEN,"SIG",C,0)
- .S $P(APCHSTAT("PENDING",APCHN,PEN),U,2)=X
- DISP ;DISPLAY MEDS
- ;ACTIVE MEDS FIRST - ALL OF THEM
- X APCHSCKP Q:$D(APCHSQIT)
- I '$D(APCHSTAT("ACTIVE MEDICATIONS")) G OUT
- W "ACTIVE MEDICATIONS",!
- S APCHCNT=0
- S APCHT=1
- S APCHN="" F S APCHN=$O(APCHSTAT("ACTIVE MEDICATIONS",APCHN)) Q:APCHN=""!($D(APCHSQIT)) D
- .S APCHDI="" F S APCHDI=$O(APCHSTAT("ACTIVE MEDICATIONS",APCHN,APCHDI)) Q:APCHDI=""!($D(APCHSQIT)) D
- ..S APCHDT=0 F S APCHDT=$O(APCHSTAT("ACTIVE MEDICATIONS",APCHN,APCHDI,APCHDT)) Q:APCHDT'=+APCHDT!($D(APCHSQIT)) D
- ...S APCHM=0 F S APCHM=$O(APCHSTAT("ACTIVE MEDICATIONS",APCHN,APCHDI,APCHDT,APCHM)) Q:APCHM'=+APCHM!($D(APCHSQIT)) S APCHZ=APCHSTAT("ACTIVE MEDICATIONS",APCHN,APCHDI,APCHDT,APCHM) D MEDDSP
- OUT ;OUTSIDE MEDICATIONS
- I '$D(APCHSTAT("OUTSIDE MEDICATIONS")),'$D(APCHSTAT("NVA")) G HOLD
- W "--------------------",!
- W "OUTSIDE MEDICATIONS",!
- S APCHN="" F S APCHN=$O(APCHSTAT("OUTSIDE MEDICATIONS",APCHN)) Q:APCHN=""!($D(APCHSQIT)) D
- .S APCHDI="" F S APCHDI=$O(APCHSTAT("OUTSIDE MEDICATIONS",APCHN,APCHDI)) Q:APCHDI=""!($D(APCHSQIT)) D
- ..S APCHDT=0 S APCHDT=$O(APCHSTAT("OUTSIDE MEDICATIONS",APCHN,APCHDI,APCHDT)) Q:APCHDT'=+APCHDT!($D(APCHSQIT)) D
- ...S APCHM=0 S APCHM=$O(APCHSTAT("OUTSIDE MEDICATIONS",APCHN,APCHDI,APCHDT,APCHM)) Q:APCHM'=+APCHM!($D(APCHSQIT)) S APCHZ=APCHSTAT("OUTSIDE MEDICATIONS",APCHN,APCHDI,APCHDT,APCHM) D MEDDSPO
- ;now display nva
- S APCHN="" F S APCHN=$O(APCHSTAT("NVA",APCHN)) Q:APCHN=""!($D(APCHSQIT)) D
- .S APCHDI="" F S APCHDI=$O(APCHSTAT("NVA",APCHN,APCHDI)) Q:APCHDI=""!($D(APCHSQIT)) D
- ..S APCHDT=0 S APCHDT=$O(APCHSTAT("NVA",APCHN,APCHDI,APCHDT)) Q:APCHDT'=+APCHDT!($D(APCHSQIT)) D
- ...S APCHZ=APCHSTAT("NVA",APCHN,APCHDI,APCHDT) D MEDDSPN
- HOLD ;HOLD MEDICATIONS
- I '$D(APCHSTAT("HOLD MEDICATIONS")) G SUSPEND
- S APCHT=3
- W "--------------------",!
- W "ACTIVE NOT DISPENSED MEDICATIONS",!
- S APCHN="" F S APCHN=$O(APCHSTAT("HOLD MEDICATIONS",APCHN)) Q:APCHN=""!($D(APCHSQIT)) D
- .S APCHDI="" F S APCHDI=$O(APCHSTAT("HOLD MEDICATIONS",APCHN,APCHDI)) Q:APCHDI=""!($D(APCHSQIT)) D
- ..S APCHDT=0 F S APCHDT=$O(APCHSTAT("HOLD MEDICATIONS",APCHN,APCHDI,APCHDT)) Q:APCHDT'=+APCHDT!($D(APCHSQIT)) D
- ...S APCHM=0 F S APCHM=$O(APCHSTAT("HOLD MEDICATIONS",APCHN,APCHDI,APCHDT,APCHM)) Q:APCHM'=+APCHM!($D(APCHSQIT)) S APCHZ=APCHSTAT("HOLD MEDICATIONS",APCHN,APCHDI,APCHDT,APCHM) D MEDDSP
- SUSPEND ;
- I '$D(APCHSTAT("SUSPEND MEDICATIONS")) G PENDING
- S APCHT=4
- W !,"--------------------",!
- W "SUSPENDED MEDICATIONS",!
- S APCHN="" F S APCHN=$O(APCHSTAT("SUSPEND MEDICATIONS",APCHN)) Q:APCHN=""!($D(APCHSQIT)) D
- .S APCHDI="" F S APCHDI=$O(APCHSTAT("SUSPEND MEDICATIONS",APCHN,APCHDI)) Q:APCHDI=""!($D(APCHSQIT)) D
- ..S APCHDT=0 F S APCHDT=$O(APCHSTAT("SUSPEND MEDICATIONS",APCHN,APCHDI,APCHDT)) Q:APCHDT'=+APCHDT!($D(APCHSQIT)) D
- ...S APCHM=0 F S APCHM=$O(APCHSTAT("SUSPEND MEDICATIONS",APCHN,APCHDI,APCHDT,APCHM)) Q:APCHM'=+APCHM!($D(APCHSQIT)) S APCHZ=APCHSTAT("SUSPEND MEDICATIONS",APCHN,APCHDI,APCHDT,APCHM) D MEDDSP
- PENDING ;
- I '$D(APCHSTAT("PENDING")) G EXPIRED
- W "--------------------",!
- W "PENDING MEDICATIONS",!
- S APCHN="" F S APCHN=$O(APCHSTAT("PENDING",APCHN)) Q:APCHN=""!($D(APCHSQIT)) D
- .S APCHDI="" F S APCHDI=$O(APCHSTAT("PENDING",APCHN,APCHDI)) Q:APCHDI=""!($D(APCHSQIT)) D
- ..S APCHZ=APCHSTAT("PENDING",APCHN,APCHDI) D MEDDSPP
- EXPIRED ;
- I '$D(APCHSTAT("EXPIRED MEDICATIONS")) G DISCONT
- S APCHT=6
- W "--------------------",!
- W "CHRONIC AND RECENTLY EXPIRED MEDICATIONS",!
- S APCHN="" F S APCHN=$O(APCHSTAT("EXPIRED MEDICATIONS",APCHN)) Q:APCHN=""!($D(APCHSQIT)) D
- .S APCHDI="" F S APCHDI=$O(APCHSTAT("EXPIRED MEDICATIONS",APCHN,APCHDI)) Q:APCHDI=""!($D(APCHSQIT)) D
- ..S APCHDT=0 F S APCHDT=$O(APCHSTAT("EXPIRED MEDICATIONS",APCHN,APCHDI,APCHDT)) Q:APCHDT'=+APCHDT!($D(APCHSQIT)) D
- ...S APCHM=0 F S APCHM=$O(APCHSTAT("EXPIRED MEDICATIONS",APCHN,APCHDI,APCHDT,APCHM)) Q:APCHM'=+APCHM!($D(APCHSQIT)) S APCHZ=APCHSTAT("EXPIRED MEDICATIONS",APCHN,APCHDI,APCHDT,APCHM) D MEDDSP
- DISCONT ;
- I '$D(APCHSTAT("DISCONTINUED MEDICATIONS")) G MEDX
- S APCHT=7
- W "--------------------",!
- W "RECENTLY DISCONTINUED MEDICATIONS",!
- S APCHN="" F S APCHN=$O(APCHSTAT("DISCONTINUED MEDICATIONS",APCHN)) Q:APCHN=""!($D(APCHSQIT)) D
- .S APCHDI="" F S APCHDI=$O(APCHSTAT("DISCONTINUED MEDICATIONS",APCHN,APCHDI)) Q:APCHDI=""!($D(APCHSQIT)) D
- ..S APCHDT=0 F S APCHDT=$O(APCHSTAT("DISCONTINUED MEDICATIONS",APCHN,APCHDI,APCHDT)) Q:APCHDT'=+APCHDT!($D(APCHSQIT)) D
- ...S APCHM=0 F S APCHM=$O(APCHSTAT("DISCONTINUED MEDICATIONS",APCHN,APCHDI,APCHDT,APCHM)) Q:APCHM'=+APCHM!($D(APCHSQIT)) S APCHZ=APCHSTAT("DISCONTINUED MEDICATIONS",APCHN,APCHDI,APCHDT,APCHM) D MEDDSP
- MEDX ;
- Q
- MEDDSPP ;DISPLAY MEDICATION
- S APCHCNT=APCHCNT+1
- X APCHSCKP Q:$D(APCHSQIT)
- W APCHCNT,".",?6,APCHN W:$P(APCHZ,U,2) ?60,"Refills: ",$S('$P(APCHZ,U,1):"NONE",1:$P(APCHZ,U,1)) W !
- X APCHSCKP Q:$D(APCHSQIT)
- K ^UTILITY($J,"W") S X=$P(APCHZ,U,2),DIWL=0,DIWR=60 D ^DIWP
- W ?6,"Directions: "_$S($L($G(^UTILITY($J,"W",0,1,0)))>1:$G(^UTILITY($J,"W",0,1,0)),$L($G(^UTILITY($J,"W",0,1,0)))=1:"No directions on file",1:" "),!
- I $G(^UTILITY($J,"W",0))>1 F F=2:1:$G(^UTILITY($J,"W",0)) Q:$D(APCHSQIT) D
- .X APCHSCKP Q:$D(APCHSQIT)
- .W ?19,$G(^UTILITY($J,"W",0,F,0)),!
- K ^UTILITY($J,"W")
- Q
- MEDDSPO ;DISPLAY MEDICATION
- S APCHSN=^AUPNVMED(APCHM,0)
- S APCHCNT=APCHCNT+1
- X APCHSCKP Q:$D(APCHSQIT)
- W APCHCNT,".",?6,APCHN W:$P(APCHZ,U,2) ?60,"Refills left: ",$S('$P(APCHZ,U,2):"NONE",1:$P(APCHZ,U,2)) W !
- X APCHSCKP Q:$D(APCHSQIT)
- S APCHSIG=$P(^AUPNVMED(APCHM,0),U,5) D SIG
- S X=APCHSSGY
- K ^UTILITY($J,"W") S DIWL=0,DIWR=60 D ^DIWP
- X APCHSCKP Q:$D(APCHSQIT)
- W ?6,"Directions: "_$S($L($G(^UTILITY($J,"W",0,1,0)))>1:$G(^UTILITY($J,"W",0,1,0)),$L($G(^UTILITY($J,"W",0,1,0)))=1:"No directions on file",1:" "),!
- I $G(^UTILITY($J,"W",0))>1 F F=2:1:$G(^UTILITY($J,"W",0)) Q:$D(APCHSQIT) D
- .X APCHSCKP Q:$D(APCHSQIT)
- .W ?19,$G(^UTILITY($J,"W",0,F,0)),!
- K ^UTILITY($J,"W")
- Q
- MEDDSPN ;
- S APCHCNT=APCHCNT+1
- X APCHSCKP Q:$D(APCHSQIT)
- W APCHCNT,".",?6,APCHN,! ;W:$P(APCHZ,U,2) ?60,"Refills left: ",$S('$P(APCHZ,U,2):"NONE",1:$P(APCHZ,U,2)) W !
- X APCHSCKP Q:$D(APCHSQIT)
- S APCHSIG=$P(APCHZ,U,8) D SIG
- S X=APCHSSGY
- K ^UTILITY($J,"W") S DIWL=0,DIWR=60 D ^DIWP
- X APCHSCKP Q:$D(APCHSQIT)
- W ?6,"Directions: "_$S($L($G(^UTILITY($J,"W",0,1,0)))>1:$G(^UTILITY($J,"W",0,1,0)),$L($G(^UTILITY($J,"W",0,1,0)))=1:"No directions on file",1:" "),!
- I $G(^UTILITY($J,"W",0))>1 F F=2:1:$G(^UTILITY($J,"W",0)) Q:$D(APCHSQIT) D
- .X APCHSCKP Q:$D(APCHSQIT)
- .W ?19,$G(^UTILITY($J,"W",0,F,0)),!
- I $P(APCHZ,U,9) W !?19,"DATE DISCONTINUED: ",$$FMTE^XLFDT($P(APCHZ,U,9))
- K ^UTILITY($J,"W")
- Q
- MEDDSP ;DISPLAY MEDICATION
- S APCHSN=^AUPNVMED(APCHM,0)
- S APCHCNT=APCHCNT+1
- X APCHSCKP Q:$D(APCHSQIT)
- W APCHCNT,".",?6,APCHN,?40,"Rx #:",$P(APCHZ,U,1),?60,"Refills left: ",$S('$P(APCHZ,U,2):"NONE",1:$P(APCHZ,U,2)),!
- X APCHSCKP Q:$D(APCHSQIT)
- S APCHSIG=$P(^AUPNVMED(APCHM,0),U,5) D SIG
- S X=APCHSSGY
- K ^UTILITY($J,"W") S DIWL=0,DIWR=60 D ^DIWP
- X APCHSCKP Q:$D(APCHSQIT)
- W ?6,"Directions: "_$S($L($G(^UTILITY($J,"W",0,1,0)))>1:$G(^UTILITY($J,"W",0,1,0)),$L($G(^UTILITY($J,"W",0,1,0)))=1:"No directions on file",1:" "),!
- I $G(^UTILITY($J,"W",0))>1 F F=2:1:$G(^UTILITY($J,"W",0)) Q:$D(APCHSQIT) D
- .X APCHSCKP Q:$D(APCHSQIT)
- .W ?19,$G(^UTILITY($J,"W",0,F,0)),!
- K ^UTILITY($J,"W")
- X APCHSCKP Q:$D(APCHSQIT)
- I APCHT=1!(APCHT=6) W ?6,"Last Filled: ",$$D(9999999-APCHDT) D
- .S APCHSORT="" I APCHT=1 S APCHSORT=$P($G(^AUPNVMED(APCHM,11)),U)
- .I APCHSORT["RETURNED TO STOCK" W " ---",APCHSORT," ",$$FMTE^XLFDT($P(^AUPNVMED(APCHM,0),U,8),"2D")
- I APCHT=6 I $P(APCHZ,U,1) S E=$P($G(^PSRX($P(APCHZ,U,1),3)),U,6) W ?30,"Expired: ",$$D(E)
- W !
- I APCHT=3 W ?6,"Hold Reason: " I $P(APCHZ,U,1) W $P($G(^PSRX($P(APCHZ,U,1),"H")),U,1)
- I APCHT=7 W ?6,"Discontinued: " D
- .S E=$P(^AUPNVMED(APCHM,0),U,8) ;discontinued date in v med
- .I E="",$P(APCHZ,U,1) S E=$P($G(^PSRX($P(APCHZ,U,1),3)),U,5) ;canceled date in 52
- .W $$D(E),!
- Q
- D(D) ;
- I D="" Q ""
- Q $E(D,4,5)_"-"_$E(D,6,7)_"-"_$E(D,2,3)
- ;
- SIG ;CONSTRUCT THE FULL TEXT FROM THE ENCODED SIG
- S APCHSSGY="" F APCHSP=1:1:$L(APCHSIG," ") S X=$P(APCHSIG," ",APCHSP) I X]"" D
- . 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)
- . S APCHSSGY=APCHSSGY_X_" "
- Q
- ;
- REF ;DETERMINE THE NUMBER OF REFILLS REMAINING
- I 'APCHSRX S APCHSREF=$P($G(^AUPNVMED(M,11)),U,7) S:APCHSREF="" APCHSREF=0 Q
- S APCHSRFL=$P(^PSRX(APCHSRX,0),U,9) S APCHSREF=0 F S APCHSREF=$O(^PSRX(APCHSRX,1,APCHSREF)) Q:'APCHSREF S APCHSRFL=APCHSRFL-1
- S APCHSREF=APCHSRFL
- Q
- ;
- ;
- SITE ;DETERMINE IF OUTSIDE LOCATION INFO PRESENT
- S APCHSITE=""
- I $D(^AUPNVSIT(APCHSVDF,21))#2 S APCHSITE=$P(^(21),U) Q
- Q:$P(^AUPNVSIT(APCHSVDF,0),U,6)=""
- 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)
- Q
- ;
- CS(D) ;
- I $P(^PSDRUG(D,0),U,3)="" Q 0
- NEW Y S Y=$P(^PSDRUG(D,0),U,3)
- ;I Y[1 Q 1
- I Y[2 Q 1
- I Y[3 Q 1
- I Y[4 Q 1
- I Y[5 Q 1
- ;I Y["C" Q 1
- ;I Y["A" Q 1
- Q 0
- ;
- CTR(X,Y) ;EP - Center X in a field Y wide.
- Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
- APCHS7R ; IHS/CMI/LAB - PART 7 OF APCHS -- SUMMARY PRODUCTION COMPONENTS ;
- +1 ;;2.0;IHS PCC SUITE;**2,5**;MAY 14, 2009
- +2 ;
- SET ;
- +1 ;S APCHCNT=APCHCNT+1
- +2 SET APCHSRX=P
- SET APCHSREF=0
- DO REF
- +3 SET APCHSTAT(C,N,D,(9999999-F),M)=$SELECT(P:$PIECE(^PSRX(P,0),U),1:"")_U_APCHSREF
- +4 SET APCHMDSP(D,N,F)=""
- +5 QUIT
- MEDRCON ; ************* MEDS BY PRESCRIPTION STATUS *************
- +1 ;
- CONT ; <SETUP>
- +1 IF '$DATA(^AUPNVMED("AC",APCHSPAT))
- IF '$DATA(^PS(52.41,"P",APCHSPAT))
- IF '$DATA(^PS(55,APCHSPAT,"NVA"))
- QUIT
- +2 XECUTE APCHSCKP
- IF $DATA(APCHSQIT)
- QUIT
- IF 'APCHSNPG
- WRITE !
- XECUTE APCHSBRK
- +3 ; <BUILD>
- +4 NEW APCHMEDS,APCHSTAT,APCHCNT,APCHMDSP,APCHDI,APCHDT,APCHM,APCHN,APCHSSGY,APCHSIG,APCHZ,APCHSN,APCHST,APCHI,APCHD
- +5 NEW X,F,M,V,D,N,P,C,E,S,R,J
- +6 SET APCHCNT=0
- +7 KILL APCHMEDS,APCHMDSP
- +8 DO GETMEDS^APCHSMU1(APCHSPAT,$$FMADD^XLFDT(DT,-395),DT,,,,,.APCHMEDS)
- +9 ;I '$D(APCHMEDS) D MEDX Q
- +10 ;NOW REORDER THEM BY STATUS
- +11 KILL APCHSTAT
- +12 SET X=0
- FOR
- SET X=$ORDER(APCHMEDS(X))
- IF X'=+X
- QUIT
- Begin DoDot:1
- +13 SET P=""
- +14 ;FILL DATE
- SET F=$PIECE(APCHMEDS(X),U,1)
- +15 ;vmed ien
- SET M=$PIECE(APCHMEDS(X),U,4)
- +16 ;visit ien
- SET V=$PIECE(APCHMEDS(X),U,5)
- +17 ;drug ien
- SET D=$PIECE(^AUPNVMED(M,0),U)
- +18 ;non table drug name
- SET N=$PIECE(^AUPNVMED(M,0),U,4)
- +19 ;drug name
- IF N=""
- SET N=$PIECE(^PSDRUG(D,0),U)
- +20 IF $PIECE($GET(^AUPNVSIT(X,0)),U,7)="E"
- SET C="OUTSIDE MEDICATIONS"
- DO SET
- QUIT
- +21 ;I $P($G(^AUPNVMED(X,11)),U,8)]"" Q ;we will get EHR outside meds from the NVA multiple later S C="OUTSIDE MEDICATIONS" D SET Q
- +22 SET P=$ORDER(^PSRX("APCC",M,0))
- +23 IF 'P
- SET C="OUTSIDE MEDICATIONS"
- DO SET
- QUIT
- +24 IF '$DATA(^PSRX(P,0))
- SET P=""
- SET C="OUTSIDE MEDICATIONS"
- DO SET
- QUIT
- +25 ;GET STATUS
- SET S=$$VALI^XBDIQ1(52,P,100)
- +26 IF S=0
- SET C="ACTIVE MEDICATIONS"
- DO SET
- QUIT
- +27 IF S=3
- SET C="HOLD"
- DO SET
- QUIT
- +28 IF S=5
- SET C="SUSPENDED"
- DO SET
- QUIT
- +29 IF S=11
- Begin DoDot:2
- +30 ;get expiration date
- +31 SET E=$PIECE($GET(^PSRX(P,3)),U,6)
- +32 ;chronic flag
- SET R=$$CHRONIC^APCHS72(M)
- +33 IF 'R
- Begin DoDot:3
- +34 ;not chronic, check to see if expired in past 14 days, if not quit
- +35 SET J=$$FMDIFF^XLFDT(DT,E)
- +36 ;more than 14 days ago so don't display
- IF J>14
- QUIT
- +37 ;check to see if same drug is already listed somewhere
- +38 ;another of same drug after this date
- IF $ORDER(APCHMDSP(D,N,F))
- QUIT
- +39 SET C="EXPIRED"
- DO SET
- QUIT
- End DoDot:3
- QUIT
- +40 ;chronic = check 120 days
- +41 SET J=$$FMDIFF^XLFDT(DT,E)
- +42 ;expired more than 120 days ago
- IF J>120
- QUIT
- +43 ;another one there so don't display this one
- IF $ORDER(APCHMDSP(D,N,F))
- QUIT
- +44 SET C="EXPIRED"
- DO SET
- QUIT
- End DoDot:2
- QUIT
- +45 IF S=12!(S=14)
- Begin DoDot:2
- +46 ;discontinued date in v med
- SET E=$PIECE(^AUPNVMED(M,0),U,8)
- +47 ;canceled date in 52
- IF E=""
- SET E=$PIECE($GET(^PSRX(P,3)),U,5)
- +48 ;only discontinueds in past 30 days
- IF $$FMDIFF^XLFDT(DT,E)>30
- QUIT
- +49 IF $ORDER(APCHMDSP(D,N,F))
- QUIT
- +50 SET C="DISCONTINUED MEDICATIONS"
- DO SET
- QUIT
- End DoDot:2
- End DoDot:1
- GETNVA ;NVA from file 55
- +1 SET X=0
- FOR
- SET X=$ORDER(^PS(55,APCHSPAT,"NVA",X))
- IF X'=+X
- QUIT
- Begin DoDot:1
- +2 ;got this with V MED
- IF $PIECE($GET(^PS(55,APCHSPAT,"NVA",X,999999911)),U,1)
- IF $DATA(^AUPNVMED($PIECE(^PS(55,APCHSPAT,"NVA",X,999999911),U,1),0))
- QUIT
- +3 ;S L=$P(^PS(55,APCHSPAT,"NVA",X,0),U,9)
- +4 ;:'L
- +5 SET L=$PIECE($PIECE($GET(^PS(55,APCHSPAT,"NVA",X,0)),U,10),".")
- +6 SET L=9999999-L
- +7 ;Q:$P(^PS(55,APCHSPAT,"NVA",X,0),U,6)=1 ;discontinued
- +8 ;I $P(^PS(55,APCHSPAT,"NVA",X,0),U,7)]"" ;discontinued date
- +9 SET D=$PIECE(^PS(55,APCHSPAT,"NVA",X,0),U,2)
- +10 IF D=""
- SET D="NO DRUG IEN"
- +11 SET N=$SELECT(D:$PIECE(^PSDRUG(D,0),U,1),1:$PIECE(^PS(50.7,$PIECE(^PS(55,APCHSPAT,"NVA",X,0),U,1),0),U,1))
- +12 SET APCHSTAT("NVA",N,D,(9999999-L))=U_"N"
- SET $PIECE(APCHSTAT("NVA",N,D,(9999999-L)),U,8)=$PIECE(^PS(55,APCHSPAT,"NVA",X,0),U,4)_" "_$PIECE(^PS(55,APCHSPAT,"NVA",X,0),U,5)_U_$PIECE(^PS(55,APCHSPAT,"NVA",X,0),U,7)
- End DoDot:1
- GETPEND ;
- +1 NEW PEN,ORD
- +2 FOR PEN=0:0
- SET PEN=$ORDER(^PS(52.41,"P",APCHSPAT,PEN))
- IF 'PEN
- QUIT
- SET ORD=^PS(52.41,PEN,0)
- SET APCHI=$PIECE(ORD,"^",8)
- SET APCHD=+$PIECE(ORD,"^",9)
- IF $PIECE(ORD,"^",3)'="DC"&($PIECE(ORD,"^",3)'="DE")&($PIECE(ORD,"^",3)'="HD")
- Begin DoDot:1
- +3 SET APCHN=$SELECT(APCHD:$PIECE($GET(^PSDRUG(APCHD,0)),"^"),+APCHI&('APCHD):$PIECE(^PS(50.7,APCHI,0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^PS(50.7,APCHI,0),"^",2),0),"^"),1:"")
- IF APCHN']""
- QUIT
- +4 SET APCHSTAT("PENDING",APCHN,PEN)=$$VAL^XBDIQ1(52.41,PEN,13)
- +5 SET C=0
- SET X=""
- FOR
- SET C=$ORDER(^PS(52.41,PEN,"SIG",C))
- IF 'C
- QUIT
- SET X=X_$SELECT(X]"":" ",1:"")_^PS(52.41,PEN,"SIG",C,0)
- +6 SET $PIECE(APCHSTAT("PENDING",APCHN,PEN),U,2)=X
- End DoDot:1
- DISP ;DISPLAY MEDS
- +1 ;ACTIVE MEDS FIRST - ALL OF THEM
- +2 XECUTE APCHSCKP
- IF $DATA(APCHSQIT)
- QUIT
- +3 IF '$DATA(APCHSTAT("ACTIVE MEDICATIONS"))
- GOTO OUT
- +4 WRITE "ACTIVE MEDICATIONS",!
- +5 SET APCHCNT=0
- +6 SET APCHT=1
- +7 SET APCHN=""
- FOR
- SET APCHN=$ORDER(APCHSTAT("ACTIVE MEDICATIONS",APCHN))
- IF APCHN=""!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:1
- +8 SET APCHDI=""
- FOR
- SET APCHDI=$ORDER(APCHSTAT("ACTIVE MEDICATIONS",APCHN,APCHDI))
- IF APCHDI=""!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:2
- +9 SET APCHDT=0
- FOR
- SET APCHDT=$ORDER(APCHSTAT("ACTIVE MEDICATIONS",APCHN,APCHDI,APCHDT))
- IF APCHDT'=+APCHDT!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:3
- +10 SET APCHM=0
- FOR
- SET APCHM=$ORDER(APCHSTAT("ACTIVE MEDICATIONS",APCHN,APCHDI,APCHDT,APCHM))
- IF APCHM'=+APCHM!($DATA(APCHSQIT))
- QUIT
- SET APCHZ=APCHSTAT("ACTIVE MEDICATIONS",APCHN,APCHDI,APCHDT,APCHM)
- DO MEDDSP
- End DoDot:3
- End DoDot:2
- End DoDot:1
- OUT ;OUTSIDE MEDICATIONS
- +1 IF '$DATA(APCHSTAT("OUTSIDE MEDICATIONS"))
- IF '$DATA(APCHSTAT("NVA"))
- GOTO HOLD
- +2 WRITE "--------------------",!
- +3 WRITE "OUTSIDE MEDICATIONS",!
- +4 SET APCHN=""
- FOR
- SET APCHN=$ORDER(APCHSTAT("OUTSIDE MEDICATIONS",APCHN))
- IF APCHN=""!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:1
- +5 SET APCHDI=""
- FOR
- SET APCHDI=$ORDER(APCHSTAT("OUTSIDE MEDICATIONS",APCHN,APCHDI))
- IF APCHDI=""!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:2
- +6 SET APCHDT=0
- SET APCHDT=$ORDER(APCHSTAT("OUTSIDE MEDICATIONS",APCHN,APCHDI,APCHDT))
- IF APCHDT'=+APCHDT!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:3
- +7 SET APCHM=0
- SET APCHM=$ORDER(APCHSTAT("OUTSIDE MEDICATIONS",APCHN,APCHDI,APCHDT,APCHM))
- IF APCHM'=+APCHM!($DATA(APCHSQIT))
- QUIT
- SET APCHZ=APCHSTAT("OUTSIDE MEDICATIONS",APCHN,APCHDI,APCHDT,APCHM)
- DO MEDDSPO
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +8 ;now display nva
- +9 SET APCHN=""
- FOR
- SET APCHN=$ORDER(APCHSTAT("NVA",APCHN))
- IF APCHN=""!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:1
- +10 SET APCHDI=""
- FOR
- SET APCHDI=$ORDER(APCHSTAT("NVA",APCHN,APCHDI))
- IF APCHDI=""!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:2
- +11 SET APCHDT=0
- SET APCHDT=$ORDER(APCHSTAT("NVA",APCHN,APCHDI,APCHDT))
- IF APCHDT'=+APCHDT!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:3
- +12 SET APCHZ=APCHSTAT("NVA",APCHN,APCHDI,APCHDT)
- DO MEDDSPN
- End DoDot:3
- End DoDot:2
- End DoDot:1
- HOLD ;HOLD MEDICATIONS
- +1 IF '$DATA(APCHSTAT("HOLD MEDICATIONS"))
- GOTO SUSPEND
- +2 SET APCHT=3
- +3 WRITE "--------------------",!
- +4 WRITE "ACTIVE NOT DISPENSED MEDICATIONS",!
- +5 SET APCHN=""
- FOR
- SET APCHN=$ORDER(APCHSTAT("HOLD MEDICATIONS",APCHN))
- IF APCHN=""!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:1
- +6 SET APCHDI=""
- FOR
- SET APCHDI=$ORDER(APCHSTAT("HOLD MEDICATIONS",APCHN,APCHDI))
- IF APCHDI=""!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:2
- +7 SET APCHDT=0
- FOR
- SET APCHDT=$ORDER(APCHSTAT("HOLD MEDICATIONS",APCHN,APCHDI,APCHDT))
- IF APCHDT'=+APCHDT!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:3
- +8 SET APCHM=0
- FOR
- SET APCHM=$ORDER(APCHSTAT("HOLD MEDICATIONS",APCHN,APCHDI,APCHDT,APCHM))
- IF APCHM'=+APCHM!($DATA(APCHSQIT))
- QUIT
- SET APCHZ=APCHSTAT("HOLD MEDICATIONS",APCHN,APCHDI,APCHDT,APCHM)
- DO MEDDSP
- End DoDot:3
- End DoDot:2
- End DoDot:1
- SUSPEND ;
- +1 IF '$DATA(APCHSTAT("SUSPEND MEDICATIONS"))
- GOTO PENDING
- +2 SET APCHT=4
- +3 WRITE !,"--------------------",!
- +4 WRITE "SUSPENDED MEDICATIONS",!
- +5 SET APCHN=""
- FOR
- SET APCHN=$ORDER(APCHSTAT("SUSPEND MEDICATIONS",APCHN))
- IF APCHN=""!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:1
- +6 SET APCHDI=""
- FOR
- SET APCHDI=$ORDER(APCHSTAT("SUSPEND MEDICATIONS",APCHN,APCHDI))
- IF APCHDI=""!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:2
- +7 SET APCHDT=0
- FOR
- SET APCHDT=$ORDER(APCHSTAT("SUSPEND MEDICATIONS",APCHN,APCHDI,APCHDT))
- IF APCHDT'=+APCHDT!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:3
- +8 SET APCHM=0
- FOR
- SET APCHM=$ORDER(APCHSTAT("SUSPEND MEDICATIONS",APCHN,APCHDI,APCHDT,APCHM))
- IF APCHM'=+APCHM!($DATA(APCHSQIT))
- QUIT
- SET APCHZ=APCHSTAT("SUSPEND MEDICATIONS",APCHN,APCHDI,APCHDT,APCHM)
- DO MEDDSP
- End DoDot:3
- End DoDot:2
- End DoDot:1
- PENDING ;
- +1 IF '$DATA(APCHSTAT("PENDING"))
- GOTO EXPIRED
- +2 WRITE "--------------------",!
- +3 WRITE "PENDING MEDICATIONS",!
- +4 SET APCHN=""
- FOR
- SET APCHN=$ORDER(APCHSTAT("PENDING",APCHN))
- IF APCHN=""!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:1
- +5 SET APCHDI=""
- FOR
- SET APCHDI=$ORDER(APCHSTAT("PENDING",APCHN,APCHDI))
- IF APCHDI=""!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:2
- +6 SET APCHZ=APCHSTAT("PENDING",APCHN,APCHDI)
- DO MEDDSPP
- End DoDot:2
- End DoDot:1
- EXPIRED ;
- +1 IF '$DATA(APCHSTAT("EXPIRED MEDICATIONS"))
- GOTO DISCONT
- +2 SET APCHT=6
- +3 WRITE "--------------------",!
- +4 WRITE "CHRONIC AND RECENTLY EXPIRED MEDICATIONS",!
- +5 SET APCHN=""
- FOR
- SET APCHN=$ORDER(APCHSTAT("EXPIRED MEDICATIONS",APCHN))
- IF APCHN=""!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:1
- +6 SET APCHDI=""
- FOR
- SET APCHDI=$ORDER(APCHSTAT("EXPIRED MEDICATIONS",APCHN,APCHDI))
- IF APCHDI=""!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:2
- +7 SET APCHDT=0
- FOR
- SET APCHDT=$ORDER(APCHSTAT("EXPIRED MEDICATIONS",APCHN,APCHDI,APCHDT))
- IF APCHDT'=+APCHDT!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:3
- +8 SET APCHM=0
- FOR
- SET APCHM=$ORDER(APCHSTAT("EXPIRED MEDICATIONS",APCHN,APCHDI,APCHDT,APCHM))
- IF APCHM'=+APCHM!($DATA(APCHSQIT))
- QUIT
- SET APCHZ=APCHSTAT("EXPIRED MEDICATIONS",APCHN,APCHDI,APCHDT,APCHM)
- DO MEDDSP
- End DoDot:3
- End DoDot:2
- End DoDot:1
- DISCONT ;
- +1 IF '$DATA(APCHSTAT("DISCONTINUED MEDICATIONS"))
- GOTO MEDX
- +2 SET APCHT=7
- +3 WRITE "--------------------",!
- +4 WRITE "RECENTLY DISCONTINUED MEDICATIONS",!
- +5 SET APCHN=""
- FOR
- SET APCHN=$ORDER(APCHSTAT("DISCONTINUED MEDICATIONS",APCHN))
- IF APCHN=""!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:1
- +6 SET APCHDI=""
- FOR
- SET APCHDI=$ORDER(APCHSTAT("DISCONTINUED MEDICATIONS",APCHN,APCHDI))
- IF APCHDI=""!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:2
- +7 SET APCHDT=0
- FOR
- SET APCHDT=$ORDER(APCHSTAT("DISCONTINUED MEDICATIONS",APCHN,APCHDI,APCHDT))
- IF APCHDT'=+APCHDT!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:3
- +8 SET APCHM=0
- FOR
- SET APCHM=$ORDER(APCHSTAT("DISCONTINUED MEDICATIONS",APCHN,APCHDI,APCHDT,APCHM))
- IF APCHM'=+APCHM!($DATA(APCHSQIT))
- QUIT
- SET APCHZ=APCHSTAT("DISCONTINUED MEDICATIONS",APCHN,APCHDI,APCHDT,APCHM)
- DO MEDDSP
- End DoDot:3
- End DoDot:2
- End DoDot:1
- MEDX ;
- +1 QUIT
- MEDDSPP ;DISPLAY MEDICATION
- +1 SET APCHCNT=APCHCNT+1
- +2 XECUTE APCHSCKP
- IF $DATA(APCHSQIT)
- QUIT
- +3 WRITE APCHCNT,".",?6,APCHN
- IF $PIECE(APCHZ,U,2)
- WRITE ?60,"Refills: ",$SELECT('$PIECE(APCHZ,U,1):"NONE",1:$PIECE(APCHZ,U,1))
- WRITE !
- +4 XECUTE APCHSCKP
- IF $DATA(APCHSQIT)
- QUIT
- +5 KILL ^UTILITY($JOB,"W")
- SET X=$PIECE(APCHZ,U,2)
- SET DIWL=0
- SET DIWR=60
- DO ^DIWP
- +6 WRITE ?6,"Directions: "_$SELECT($LENGTH($GET(^UTILITY($JOB,"W",0,1,0)))>1:$GET(^UTILITY($JOB,"W",0,1,0)),$LENGTH($GET(^UTILITY($JOB,"W",0,1,0)))=1:"No directions on file",1:" "),!
- +7 IF $GET(^UTILITY($JOB,"W",0))>1
- FOR F=2:1:$GET(^UTILITY($JOB,"W",0))
- IF $DATA(APCHSQIT)
- QUIT
- Begin DoDot:1
- +8 XECUTE APCHSCKP
- IF $DATA(APCHSQIT)
- QUIT
- +9 WRITE ?19,$GET(^UTILITY($JOB,"W",0,F,0)),!
- End DoDot:1
- +10 KILL ^UTILITY($JOB,"W")
- +11 QUIT
- MEDDSPO ;DISPLAY MEDICATION
- +1 SET APCHSN=^AUPNVMED(APCHM,0)
- +2 SET APCHCNT=APCHCNT+1
- +3 XECUTE APCHSCKP
- IF $DATA(APCHSQIT)
- QUIT
- +4 WRITE APCHCNT,".",?6,APCHN
- IF $PIECE(APCHZ,U,2)
- WRITE ?60,"Refills left: ",$SELECT('$PIECE(APCHZ,U,2):"NONE",1:$PIECE(APCHZ,U,2))
- WRITE !
- +5 XECUTE APCHSCKP
- IF $DATA(APCHSQIT)
- QUIT
- +6 SET APCHSIG=$PIECE(^AUPNVMED(APCHM,0),U,5)
- DO SIG
- +7 SET X=APCHSSGY
- +8 KILL ^UTILITY($JOB,"W")
- SET DIWL=0
- SET DIWR=60
- DO ^DIWP
- +9 XECUTE APCHSCKP
- IF $DATA(APCHSQIT)
- QUIT
- +10 WRITE ?6,"Directions: "_$SELECT($LENGTH($GET(^UTILITY($JOB,"W",0,1,0)))>1:$GET(^UTILITY($JOB,"W",0,1,0)),$LENGTH($GET(^UTILITY($JOB,"W",0,1,0)))=1:"No directions on file",1:" "),!
- +11 IF $GET(^UTILITY($JOB,"W",0))>1
- FOR F=2:1:$GET(^UTILITY($JOB,"W",0))
- IF $DATA(APCHSQIT)
- QUIT
- Begin DoDot:1
- +12 XECUTE APCHSCKP
- IF $DATA(APCHSQIT)
- QUIT
- +13 WRITE ?19,$GET(^UTILITY($JOB,"W",0,F,0)),!
- End DoDot:1
- +14 KILL ^UTILITY($JOB,"W")
- +15 QUIT
- MEDDSPN ;
- +1 SET APCHCNT=APCHCNT+1
- +2 XECUTE APCHSCKP
- IF $DATA(APCHSQIT)
- QUIT
- +3 ;W:$P(APCHZ,U,2) ?60,"Refills left: ",$S('$P(APCHZ,U,2):"NONE",1:$P(APCHZ,U,2)) W !
- WRITE APCHCNT,".",?6,APCHN,!
- +4 XECUTE APCHSCKP
- IF $DATA(APCHSQIT)
- QUIT
- +5 SET APCHSIG=$PIECE(APCHZ,U,8)
- DO SIG
- +6 SET X=APCHSSGY
- +7 KILL ^UTILITY($JOB,"W")
- SET DIWL=0
- SET DIWR=60
- DO ^DIWP
- +8 XECUTE APCHSCKP
- IF $DATA(APCHSQIT)
- QUIT
- +9 WRITE ?6,"Directions: "_$SELECT($LENGTH($GET(^UTILITY($JOB,"W",0,1,0)))>1:$GET(^UTILITY($JOB,"W",0,1,0)),$LENGTH($GET(^UTILITY($JOB,"W",0,1,0)))=1:"No directions on file",1:" "),!
- +10 IF $GET(^UTILITY($JOB,"W",0))>1
- FOR F=2:1:$GET(^UTILITY($JOB,"W",0))
- IF $DATA(APCHSQIT)
- QUIT
- Begin DoDot:1
- +11 XECUTE APCHSCKP
- IF $DATA(APCHSQIT)
- QUIT
- +12 WRITE ?19,$GET(^UTILITY($JOB,"W",0,F,0)),!
- End DoDot:1
- +13 IF $PIECE(APCHZ,U,9)
- WRITE !?19,"DATE DISCONTINUED: ",$$FMTE^XLFDT($PIECE(APCHZ,U,9))
- +14 KILL ^UTILITY($JOB,"W")
- +15 QUIT
- MEDDSP ;DISPLAY MEDICATION
- +1 SET APCHSN=^AUPNVMED(APCHM,0)
- +2 SET APCHCNT=APCHCNT+1
- +3 XECUTE APCHSCKP
- IF $DATA(APCHSQIT)
- QUIT
- +4 WRITE APCHCNT,".",?6,APCHN,?40,"Rx #:",$PIECE(APCHZ,U,1),?60,"Refills left: ",$SELECT('$PIECE(APCHZ,U,2):"NONE",1:$PIECE(APCHZ,U,2)),!
- +5 XECUTE APCHSCKP
- IF $DATA(APCHSQIT)
- QUIT
- +6 SET APCHSIG=$PIECE(^AUPNVMED(APCHM,0),U,5)
- DO SIG
- +7 SET X=APCHSSGY
- +8 KILL ^UTILITY($JOB,"W")
- SET DIWL=0
- SET DIWR=60
- DO ^DIWP
- +9 XECUTE APCHSCKP
- IF $DATA(APCHSQIT)
- QUIT
- +10 WRITE ?6,"Directions: "_$SELECT($LENGTH($GET(^UTILITY($JOB,"W",0,1,0)))>1:$GET(^UTILITY($JOB,"W",0,1,0)),$LENGTH($GET(^UTILITY($JOB,"W",0,1,0)))=1:"No directions on file",1:" "),!
- +11 IF $GET(^UTILITY($JOB,"W",0))>1
- FOR F=2:1:$GET(^UTILITY($JOB,"W",0))
- IF $DATA(APCHSQIT)
- QUIT
- Begin DoDot:1
- +12 XECUTE APCHSCKP
- IF $DATA(APCHSQIT)
- QUIT
- +13 WRITE ?19,$GET(^UTILITY($JOB,"W",0,F,0)),!
- End DoDot:1
- +14 KILL ^UTILITY($JOB,"W")
- +15 XECUTE APCHSCKP
- IF $DATA(APCHSQIT)
- QUIT
- +16 IF APCHT=1!(APCHT=6)
- WRITE ?6,"Last Filled: ",$$D(9999999-APCHDT)
- Begin DoDot:1
- +17 SET APCHSORT=""
- IF APCHT=1
- SET APCHSORT=$PIECE($GET(^AUPNVMED(APCHM,11)),U)
- +18 IF APCHSORT["RETURNED TO STOCK"
- WRITE " ---",APCHSORT," ",$$FMTE^XLFDT($PIECE(^AUPNVMED(APCHM,0),U,8),"2D")
- End DoDot:1
- +19 IF APCHT=6
- IF $PIECE(APCHZ,U,1)
- SET E=$PIECE($GET(^PSRX($PIECE(APCHZ,U,1),3)),U,6)
- WRITE ?30,"Expired: ",$$D(E)
- +20 WRITE !
- +21 IF APCHT=3
- WRITE ?6,"Hold Reason: "
- IF $PIECE(APCHZ,U,1)
- WRITE $PIECE($GET(^PSRX($PIECE(APCHZ,U,1),"H")),U,1)
- +22 IF APCHT=7
- WRITE ?6,"Discontinued: "
- Begin DoDot:1
- +23 ;discontinued date in v med
- SET E=$PIECE(^AUPNVMED(APCHM,0),U,8)
- +24 ;canceled date in 52
- IF E=""
- IF $PIECE(APCHZ,U,1)
- SET E=$PIECE($GET(^PSRX($PIECE(APCHZ,U,1),3)),U,5)
- +25 WRITE $$D(E),!
- End DoDot:1
- +26 QUIT
- D(D) ;
- +1 IF D=""
- QUIT ""
- +2 QUIT $EXTRACT(D,4,5)_"-"_$EXTRACT(D,6,7)_"-"_$EXTRACT(D,2,3)
- +3 ;
- SIG ;CONSTRUCT THE FULL TEXT FROM THE ENCODED SIG
- +1 SET APCHSSGY=""
- FOR APCHSP=1:1:$LENGTH(APCHSIG," ")
- SET X=$PIECE(APCHSIG," ",APCHSP)
- IF X]""
- Begin DoDot:1
- +2 SET Y=$ORDER(^PS(51,"B",X,0))
- IF Y>0
- SET X=$PIECE(^PS(51,Y,0),"^",2)
- IF $DATA(^(9))
- SET Y=$PIECE(APCHSIG," ",APCHSP-1)
- SET Y=$EXTRACT(Y,$LENGTH(Y))
- IF Y>1
- SET X=$PIECE(^(9),"^",1)
- +3 SET APCHSSGY=APCHSSGY_X_" "
- End DoDot:1
- +4 QUIT
- +5 ;
- REF ;DETERMINE THE NUMBER OF REFILLS REMAINING
- +1 IF 'APCHSRX
- SET APCHSREF=$PIECE($GET(^AUPNVMED(M,11)),U,7)
- IF APCHSREF=""
- SET APCHSREF=0
- QUIT
- +2 SET APCHSRFL=$PIECE(^PSRX(APCHSRX,0),U,9)
- SET APCHSREF=0
- FOR
- SET APCHSREF=$ORDER(^PSRX(APCHSRX,1,APCHSREF))
- IF 'APCHSREF
- QUIT
- SET APCHSRFL=APCHSRFL-1
- +3 SET APCHSREF=APCHSRFL
- +4 QUIT
- +5 ;
- +6 ;
- SITE ;DETERMINE IF OUTSIDE LOCATION INFO PRESENT
- +1 SET APCHSITE=""
- +2 IF $DATA(^AUPNVSIT(APCHSVDF,21))#2
- SET APCHSITE=$PIECE(^(21),U)
- QUIT
- +3 IF $PIECE(^AUPNVSIT(APCHSVDF,0),U,6)=""
- QUIT
- +4 IF $PIECE(^AUPNVSIT(APCHSVDF,0),U,6)'=DUZ(2)
- SET APCHSITE=$EXTRACT($PIECE(^DIC(4,$PIECE(^AUPNVSIT(APCHSVDF,0),U,6),0),U),1,30)
- +5 QUIT
- +6 ;
- CS(D) ;
- +1 IF $PIECE(^PSDRUG(D,0),U,3)=""
- QUIT 0
- +2 NEW Y
- SET Y=$PIECE(^PSDRUG(D,0),U,3)
- +3 ;I Y[1 Q 1
- +4 IF Y[2
- QUIT 1
- +5 IF Y[3
- QUIT 1
- +6 IF Y[4
- QUIT 1
- +7 IF Y[5
- QUIT 1
- +8 ;I Y["C" Q 1
- +9 ;I Y["A" Q 1
- +10 QUIT 0
- +11 ;
- CTR(X,Y) ;EP - Center X in a field Y wide.
- +1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
