- PSOPKIV2 ;BIR/MHA - Dig Signed Pending order Auto-DC message ;08/17/11
- ;;7.0;OUTPATIENT PHARMACY;**391,495,504**;DEC 1997;Build 15
- ;
- ADCMAIL ;
- N XX,QQ,ZZ S ZZ="PSOPODC" S:'$G(DFN) DFN=PSODFN D ^VADPT,ADD^VADPT
- K ^TMP(ZZ,$J)
- S XMSUB=$P(^PS(59,PSOSITE,0),"^",6)_" - DIGITALLY SIGNED "_$S($P(OR0,"^",3)="RNW":"RE",1:"")_"NEW ORDER AUTO DISCONTINUED",XMDUZ=.5
- S LC=1,^TMP(ZZ,$J,LC)="",LC=LC+1
- S ^TMP(ZZ,$J,LC)="Following order was auto discontinued when finishing a pending order due to "_$P(PKIE,": ",2),LC=LC+1
- S ^TMP(ZZ,$J,LC)="",LC=LC+1
- S ^TMP(ZZ,$J,LC)="Division : "_$P(^PS(59,PSOSITE,0),"^"),LC=LC+1
- S ^TMP(ZZ,$J,LC)="CPRS Order # : "_$P(OR0,"^"),LC=LC+1
- S ^TMP(ZZ,$J,LC)="Issue Date : "_PSONEW("ISSUE DATE"),LC=LC+1
- S ^TMP(ZZ,$J,LC)="Patient : "_$P(^DPT(DFN,0),U)_" ("_$G(VA("BID"))_")",LC=LC+1
- ;S ^TMP(ZZ,$J,LC)="Address : ",LC=LC+1
- D PATAD
- S ^TMP(ZZ,$J,LC)="Drug : "_$G(PSODRUG("NAME")),LC=LC+1
- S QQ=PSONEW("DOSE",1) S:PSONEW("UNITS",1) QQ=QQ_"("_$P(^PS(50.607,PSONEW("UNITS",1),0),"^")_")"
- I $O(PSONEW("DOSE",1)) S XX=1 F S XX=$O(PSONEW("DOSE",XX)) Q:'XX D
- .S QQ=QQ_","_PSONEW("DOSE",XX)
- .S:PSONEW("UNITS",XX) QQ=QQ_"("_$P(^PS(50.607,PSONEW("UNITS",XX),0),"^")_")"
- S ^TMP(ZZ,$J,LC)="Dosage Ordered: "_QQ
- S LC=LC+1
- S ^TMP(ZZ,$J,LC)="Dosage Form : "_PSONEW("NOUN",1),LC=LC+1
- S ^TMP(ZZ,$J,LC)="Quantity : "_PSONEW("QTY")
- N TLC K TMP("ZZ") S XX=0,TLC=1,TMP("ZZ",1,0)="SIG : "
- F S XX=$O(^PS(52.41,ORD,"SIG",XX)) Q:'XX D
- .S QQ=^PS(52.41,ORD,"SIG",XX,0)
- .D WORDWRAP^PSOUTLA2(QQ,.TLC,$NA(TMP("ZZ")),15)
- S XX=0 F S XX=$O(TMP("ZZ",XX)) Q:'XX S ^TMP(ZZ,$J,LC+1)=TMP("ZZ",XX,0)
- S LC=LC+1
- S ^TMP(ZZ,$J,LC)="Provider : "_PSONEW("PROVIDER NAME"),LC=LC+1
- D PRV
- S LC=LC+1,^TMP(ZZ,$J,LC)=""
- I $G(PKIOR)=16 D MISMCH
- D MGRP
- S XMY(DUZ)="",XMTEXT="^TMP(ZZ,$J," N DIFROM D ^XMD K XMDUZ,XMTEXT,XMSUB
- K ^TMP(ZZ,$J)
- Q
- ;
- MISMCH ;Reason for mis-match
- N XX,XY,XZ,X1,X2,XM,PSOARY,HASH
- S HASH=$$HSHCHK^PSOPKIV1(.PSOARY,ORD) I HASH'=-1 Q
- I $O(PSOARY(""))="" Q
- ;I $G(PSOARY)'=-1 Q
- S $P(XZ," ",80)="",LC=LC+1
- S ^TMP(ZZ,$J,LC)="Differences in CPRS and Pharmacy Pending File",LC=LC+1,^TMP(ZZ,$J,LC)=""
- S LC=LC+1,^TMP(ZZ,$J,LC)="Data Name CPRS File Pharmacy Pending File"
- S LC=LC+1,^TMP(ZZ,$J,LC)="--------- --------- ---------------------"
- S LC=LC+1,XX=""
- F S XX=$O(PSOARY(XX)) Q:XX="" D
- .S XY=PSOARY(XX),LC=LC+1
- .S X1=$P(XY,"^"),X2=$P(XY,"^",2)
- .S XM=$S($L(X1)>$L(X2):X1,1:X2),STR=""
- .F I=0:1:$L(XM) Q:$E(XM,28*I,$L(XM))="" D
- .. S ^TMP(ZZ,$J,LC)=$S(I=0:$E(XX,1,18),1:"")_$$BLNK(19,$S(I=0:$E(XX,1,18),1:""))_$E(X1,(28*I),(28*I+28))_$$BLNK(29,$S($E(X1,(28*I),(28*I+28))]"":$E(X1,(28*I),(28*I+28)),1:""))_$E(X2,(28*I),(28*I+28)),LC=LC+1
- Q
- ;
- BLNK(X,STR) ;blank spaces
- N XZ,SP
- Q:X="" ""
- S $P(XZ," ",80)="",SP=X-$L(STR)
- Q $E(XZ,1,SP)
- MGRP ;
- N MDUZ S MDUZ=0 F S MDUZ=$O(^XUSEC("PSDMGR",MDUZ)) Q:MDUZ'>0 S XMY(MDUZ)=""
- Q
- ;
- PRV ;
- N DEA,VADD,PRV,DRG,ORN
- S PRV=$G(PSONEW("PROVIDER")),DRG=$G(PSODRUG("IEN")),ORN=$P(OR0,"^")
- I PRV="" Q
- S DEA=$$DEA^XUSER(0,PRV)
- S DEA=$S(DEA["-":"VA# : ",1:"DEA# : ")_DEA
- S ^TMP(ZZ,$J,LC)=DEA
- I $$DETOX^PSSOPKI(DRG),$$RXDETOX^PSOUTIL(,+$G(ORN))'="" S ^TMP(ZZ,$J,LC)=^TMP(ZZ,$J,LC)_" DETOX#: "_$$RXDETOX^PSOUTIL(,+$G(ORN))
- D PRVAD
- I $G(VADD(1))]"" D
- .S LC=LC+1,^TMP(ZZ,$J,LC)="Site Address : "_VADD(1)
- .S:VADD(2)'="" LC=LC+1,^TMP(ZZ,$J,LC)=" "_VADD(2)
- .S:VADD(3)'="" LC=LC+1,^TMP(ZZ,$J,LC)=" "_VADD(3)
- Q
- ;
- PRVAD ;
- K ^TMP($J,"ORDEA")
- D ARCHIVE^ORDEA(ORN)
- I $D(^TMP($J,"ORDEA",ORN,3)) S VADD=^(3) D
- .S VADD(1)=$P(VADD,"^",2),VADD(2)=$P(VADD,"^",3),VADD(3)=$P(VADD,"^",4)_", "_$P(VADD,"^",5)_" "_$P($P(VADD,"^",6),"-")
- K ^TMP($J,"ORDEA")
- Q
- ;
- PATAD ;
- N PSOBADR,PSOTEMP,PSOFORGN,I,T
- S PSOBADR=0,PSOTEMP=0,XX=0
- S PSOFORGN=$P($G(VAPA(25)),"^",2) I PSOFORGN'="",PSOFORGN'["UNITED STATES" S PSOFORGN=1
- I 'PSOFORGN S PSOBADR=$$BADADR^DGUTL3(DFN)
- I 'PSOFORGN,PSOBADR S PSOTEMP=$$CHKTEMP^PSOBAI(DFN)
- F I=1:1:3 I $G(VAPA(I))]"" D
- . S T="" I I=1,'PSOFORGN,PSOBADR,'$G(PSOTEMP) S T="** BAD ADDRESS INDICATED **"
- . I I=1,T="",PSOFORGN S T="*** FOREIGN ADDRESS ***"
- . I T="" I 'PSOFORGN I 'PSOBADR!$G(PSOTEMP) S T=$G(VAPA(I))
- . I I=1,T]"" S ^TMP(ZZ,$J,LC)="Address : "_T,LC=LC+1
- . I I>1,T]"" S ^TMP(ZZ,$J,LC)=" "_T,LC=LC+1
- S I=+$G(VAPA(5)) I I S I=$S($D(^DIC(5,I,0)):$P(^(0),"^",2),1:"UNKNOWN")
- S T="" I 'PSOFORGN I 'PSOBADR!$G(PSOTEMP) S T=$G(VAPA(4))_", "_I_" "_$S($G(VAPA(11)):$P(VAPA(11),"^",2),1:$G(VAPA(6)))
- S:T]"" ^TMP(ZZ,$J,LC)=" "_T,LC=LC+1
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOPKIV2 4739 printed Jan 18, 2025@03:33:51 Page 2
- PSOPKIV2 ;BIR/MHA - Dig Signed Pending order Auto-DC message ;08/17/11
- +1 ;;7.0;OUTPATIENT PHARMACY;**391,495,504**;DEC 1997;Build 15
- +2 ;
- ADCMAIL ;
- +1 NEW XX,QQ,ZZ
- SET ZZ="PSOPODC"
- if '$GET(DFN)
- SET DFN=PSODFN
- DO ^VADPT
- DO ADD^VADPT
- +2 KILL ^TMP(ZZ,$JOB)
- +3 SET XMSUB=$PIECE(^PS(59,PSOSITE,0),"^",6)_" - DIGITALLY SIGNED "_$SELECT($PIECE(OR0,"^",3)="RNW":"RE",1:"")_"NEW ORDER AUTO DISCONTINUED"
- SET XMDUZ=.5
- +4 SET LC=1
- SET ^TMP(ZZ,$JOB,LC)=""
- SET LC=LC+1
- +5 SET ^TMP(ZZ,$JOB,LC)="Following order was auto discontinued when finishing a pending order due to "_$PIECE(PKIE,": ",2)
- SET LC=LC+1
- +6 SET ^TMP(ZZ,$JOB,LC)=""
- SET LC=LC+1
- +7 SET ^TMP(ZZ,$JOB,LC)="Division : "_$PIECE(^PS(59,PSOSITE,0),"^")
- SET LC=LC+1
- +8 SET ^TMP(ZZ,$JOB,LC)="CPRS Order # : "_$PIECE(OR0,"^")
- SET LC=LC+1
- +9 SET ^TMP(ZZ,$JOB,LC)="Issue Date : "_PSONEW("ISSUE DATE")
- SET LC=LC+1
- +10 SET ^TMP(ZZ,$JOB,LC)="Patient : "_$PIECE(^DPT(DFN,0),U)_" ("_$GET(VA("BID"))_")"
- SET LC=LC+1
- +11 ;S ^TMP(ZZ,$J,LC)="Address : ",LC=LC+1
- +12 DO PATAD
- +13 SET ^TMP(ZZ,$JOB,LC)="Drug : "_$GET(PSODRUG("NAME"))
- SET LC=LC+1
- +14 SET QQ=PSONEW("DOSE",1)
- if PSONEW("UNITS",1)
- SET QQ=QQ_"("_$PIECE(^PS(50.607,PSONEW("UNITS",1),0),"^")_")"
- +15 IF $ORDER(PSONEW("DOSE",1))
- SET XX=1
- FOR
- SET XX=$ORDER(PSONEW("DOSE",XX))
- if 'XX
- QUIT
- Begin DoDot:1
- +16 SET QQ=QQ_","_PSONEW("DOSE",XX)
- +17 if PSONEW("UNITS",XX)
- SET QQ=QQ_"("_$PIECE(^PS(50.607,PSONEW("UNITS",XX),0),"^")_")"
- End DoDot:1
- +18 SET ^TMP(ZZ,$JOB,LC)="Dosage Ordered: "_QQ
- +19 SET LC=LC+1
- +20 SET ^TMP(ZZ,$JOB,LC)="Dosage Form : "_PSONEW("NOUN",1)
- SET LC=LC+1
- +21 SET ^TMP(ZZ,$JOB,LC)="Quantity : "_PSONEW("QTY")
- +22 NEW TLC
- KILL TMP("ZZ")
- SET XX=0
- SET TLC=1
- SET TMP("ZZ",1,0)="SIG : "
- +23 FOR
- SET XX=$ORDER(^PS(52.41,ORD,"SIG",XX))
- if 'XX
- QUIT
- Begin DoDot:1
- +24 SET QQ=^PS(52.41,ORD,"SIG",XX,0)
- +25 DO WORDWRAP^PSOUTLA2(QQ,.TLC,$NAME(TMP("ZZ")),15)
- End DoDot:1
- +26 SET XX=0
- FOR
- SET XX=$ORDER(TMP("ZZ",XX))
- if 'XX
- QUIT
- SET ^TMP(ZZ,$JOB,LC+1)=TMP("ZZ",XX,0)
- +27 SET LC=LC+1
- +28 SET ^TMP(ZZ,$JOB,LC)="Provider : "_PSONEW("PROVIDER NAME")
- SET LC=LC+1
- +29 DO PRV
- +30 SET LC=LC+1
- SET ^TMP(ZZ,$JOB,LC)=""
- +31 IF $GET(PKIOR)=16
- DO MISMCH
- +32 DO MGRP
- +33 SET XMY(DUZ)=""
- SET XMTEXT="^TMP(ZZ,$J,"
- NEW DIFROM
- DO ^XMD
- KILL XMDUZ,XMTEXT,XMSUB
- +34 KILL ^TMP(ZZ,$JOB)
- +35 QUIT
- +36 ;
- MISMCH ;Reason for mis-match
- +1 NEW XX,XY,XZ,X1,X2,XM,PSOARY,HASH
- +2 SET HASH=$$HSHCHK^PSOPKIV1(.PSOARY,ORD)
- IF HASH'=-1
- QUIT
- +3 IF $ORDER(PSOARY(""))=""
- QUIT
- +4 ;I $G(PSOARY)'=-1 Q
- +5 SET $PIECE(XZ," ",80)=""
- SET LC=LC+1
- +6 SET ^TMP(ZZ,$JOB,LC)="Differences in CPRS and Pharmacy Pending File"
- SET LC=LC+1
- SET ^TMP(ZZ,$JOB,LC)=""
- +7 SET LC=LC+1
- SET ^TMP(ZZ,$JOB,LC)="Data Name CPRS File Pharmacy Pending File"
- +8 SET LC=LC+1
- SET ^TMP(ZZ,$JOB,LC)="--------- --------- ---------------------"
- +9 SET LC=LC+1
- SET XX=""
- +10 FOR
- SET XX=$ORDER(PSOARY(XX))
- if XX=""
- QUIT
- Begin DoDot:1
- +11 SET XY=PSOARY(XX)
- SET LC=LC+1
- +12 SET X1=$PIECE(XY,"^")
- SET X2=$PIECE(XY,"^",2)
- +13 SET XM=$SELECT($LENGTH(X1)>$LENGTH(X2):X1,1:X2)
- SET STR=""
- +14 FOR I=0:1:$LENGTH(XM)
- if $EXTRACT(XM,28*I,$LENGTH(XM))=""
- QUIT
- Begin DoDot:2
- +15 SET ^TMP(ZZ,$JOB,LC)=$SELECT(I=0:$EXTRACT(XX,1,18),1:"")_$$BLNK(19,$SELECT(I=0:$EXTRACT(XX,1,18),1:""))_$EXTRACT(X1,(28*I),(28*I+28))_$$BLNK(29,$SELECT($EXTRACT(X1,(28*I),(28*I+28))]"":$EXTRACT(X1,(28*I),(28*I+28)),1:""))_$EXTRA
- CT(X2,(28*I),(28*I+28))
- SET LC=LC+1
- End DoDot:2
- End DoDot:1
- +16 QUIT
- +17 ;
- BLNK(X,STR) ;blank spaces
- +1 NEW XZ,SP
- +2 if X=""
- QUIT ""
- +3 SET $PIECE(XZ," ",80)=""
- SET SP=X-$LENGTH(STR)
- +4 QUIT $EXTRACT(XZ,1,SP)
- MGRP ;
- +1 NEW MDUZ
- SET MDUZ=0
- FOR
- SET MDUZ=$ORDER(^XUSEC("PSDMGR",MDUZ))
- if MDUZ'>0
- QUIT
- SET XMY(MDUZ)=""
- +2 QUIT
- +3 ;
- PRV ;
- +1 NEW DEA,VADD,PRV,DRG,ORN
- +2 SET PRV=$GET(PSONEW("PROVIDER"))
- SET DRG=$GET(PSODRUG("IEN"))
- SET ORN=$PIECE(OR0,"^")
- +3 IF PRV=""
- QUIT
- +4 SET DEA=$$DEA^XUSER(0,PRV)
- +5 SET DEA=$SELECT(DEA["-":"VA# : ",1:"DEA# : ")_DEA
- +6 SET ^TMP(ZZ,$JOB,LC)=DEA
- +7 IF $$DETOX^PSSOPKI(DRG)
- IF $$RXDETOX^PSOUTIL(,+$GET(ORN))'=""
- SET ^TMP(ZZ,$JOB,LC)=^TMP(ZZ,$JOB,LC)_" DETOX#: "_$$RXDETOX^PSOUTIL(,+$GET(ORN))
- +8 DO PRVAD
- +9 IF $GET(VADD(1))]""
- Begin DoDot:1
- +10 SET LC=LC+1
- SET ^TMP(ZZ,$JOB,LC)="Site Address : "_VADD(1)
- +11 if VADD(2)'=""
- SET LC=LC+1
- SET ^TMP(ZZ,$JOB,LC)=" "_VADD(2)
- +12 if VADD(3)'=""
- SET LC=LC+1
- SET ^TMP(ZZ,$JOB,LC)=" "_VADD(3)
- End DoDot:1
- +13 QUIT
- +14 ;
- PRVAD ;
- +1 KILL ^TMP($JOB,"ORDEA")
- +2 DO ARCHIVE^ORDEA(ORN)
- +3 IF $DATA(^TMP($JOB,"ORDEA",ORN,3))
- SET VADD=^(3)
- Begin DoDot:1
- +4 SET VADD(1)=$PIECE(VADD,"^",2)
- SET VADD(2)=$PIECE(VADD,"^",3)
- SET VADD(3)=$PIECE(VADD,"^",4)_", "_$PIECE(VADD,"^",5)_" "_$PIECE($PIECE(VADD,"^",6),"-")
- End DoDot:1
- +5 KILL ^TMP($JOB,"ORDEA")
- +6 QUIT
- +7 ;
- PATAD ;
- +1 NEW PSOBADR,PSOTEMP,PSOFORGN,I,T
- +2 SET PSOBADR=0
- SET PSOTEMP=0
- SET XX=0
- +3 SET PSOFORGN=$PIECE($GET(VAPA(25)),"^",2)
- IF PSOFORGN'=""
- IF PSOFORGN'["UNITED STATES"
- SET PSOFORGN=1
- +4 IF 'PSOFORGN
- SET PSOBADR=$$BADADR^DGUTL3(DFN)
- +5 IF 'PSOFORGN
- IF PSOBADR
- SET PSOTEMP=$$CHKTEMP^PSOBAI(DFN)
- +6 FOR I=1:1:3
- IF $GET(VAPA(I))]""
- Begin DoDot:1
- +7 SET T=""
- IF I=1
- IF 'PSOFORGN
- IF PSOBADR
- IF '$GET(PSOTEMP)
- SET T="** BAD ADDRESS INDICATED **"
- +8 IF I=1
- IF T=""
- IF PSOFORGN
- SET T="*** FOREIGN ADDRESS ***"
- +9 IF T=""
- IF 'PSOFORGN
- IF 'PSOBADR!$GET(PSOTEMP)
- SET T=$GET(VAPA(I))
- +10 IF I=1
- IF T]""
- SET ^TMP(ZZ,$JOB,LC)="Address : "_T
- SET LC=LC+1
- +11 IF I>1
- IF T]""
- SET ^TMP(ZZ,$JOB,LC)=" "_T
- SET LC=LC+1
- End DoDot:1
- +12 SET I=+$GET(VAPA(5))
- IF I
- SET I=$SELECT($DATA(^DIC(5,I,0)):$PIECE(^(0),"^",2),1:"UNKNOWN")
- +13 SET T=""
- IF 'PSOFORGN
- IF 'PSOBADR!$GET(PSOTEMP)
- SET T=$GET(VAPA(4))_", "_I_" "_$SELECT($GET(VAPA(11)):$PIECE(VAPA(11),"^",2),1:$GET(VAPA(6)))
- +14 if T]""
- SET ^TMP(ZZ,$JOB,LC)=" "_T
- SET LC=LC+1
- +15 QUIT
- +16 ;