- PSOORNE3 ;ISC-BHAM/SAB - display pending orders from backdoor ;Oct 20, 2022@15:30
- ;;7.0;OUTPATIENT PHARMACY;**11,9,39,59,46,103,124,139,152,194,391,313,444,504,441,651,545,734**;DEC 1997;Build 10
- ;Ext ref to ^SC (File #44) (DBIA 10040),^PSXOPUTL (DBIA 2200)
- ;^PS(50.606 (DBIA 2174),^PS(50.7 DBIA 2223),^PS(55,DBIA 2228)
- ;^PSDRUG (DBIA 221)
- K ^TMP("PSOPO",$J) S ORD=$P(PSOLST(ORN),"^",2) D ORD^PSOORFIN Q
- S PSODRUG("OI")=$P(OR0,"^",8),PSODRUG("OIN")=$P(^PS(50.7,$P(OR0,"^",8),0),"^")
- I $P($G(OR0),"^",9) S DREN=$P(OR0,"^",9) S POERR=1 D DRG^PSOORDRG K POERR ;D POST^PSODRG
- I '$P(OR0,"^",9) D DREN^PSOORNW2
- S PSONEW("# OF REFILLS")=$P(OR0,"^",11)
- S (Y,PSONEW("ISSUE DATE"))=$S($G(PSONEW("ISSUE DATE")):PSONEW("ISSUE DATE"),1:$E($P(OR0,"^",6),1,7)) X ^DD("DD")
- S PSONEW("CLERK CODE")=$P(OR0,"^",4),PSORX("CLERK CODE")=$P(^VA(200,$P(OR0,"^",4),0),"^")
- S (PSONEW("DFLG"),PSONEW("QFLG"))=0,PSODFN=$P(OR0,"^",2)
- I '$G(PSOMTFLG) S PSONEW("QTY")=$S($G(PSONEW("QTY")):PSONEW("QTY"),1:$P(OR0,"^",10))
- S PSONEW("MAIL/WINDOW")=$S($P(OR0,"^",17)]"":$P(OR0,"^",17),1:"W")
- S:$G(PSONEW("CLINIC"))']"" PSONEW("CLINIC")=$P(OR0,"^",13)
- S:$G(PSORX("CLINIC"))']"" PSORX("CLINIC")=$S($D(^SC(+$P(OR0,"^",13),0)):$P(^SC($P(OR0,"^",13),0),"^"),1:"")
- S PSONEW("CLERK CODE")=$P(OR0,"^",4),PSONEW("PROVIDER")=$P(OR0,"^",5),PSONEW("PROVIDER NAME")=$P(^VA(200,$P(OR0,"^",5),0),"^")
- S PSONEW("PATIENT STATUS")=$S(+$G(^PS(55,PSODFN,"PS")):+$G(^PS(55,PSODFN,"PS")),1:"")
- S PSONEW("DAYS SUPPLY")=$S(+$G(^PS(55,PSODFN,"PS"))&($P(^PS(53,+$G(^PS(55,PSODFN,"PS")),0),"^",3)):$P(^PS(53,+$G(^PS(55,PSODFN,"PS")),0),"^",3),1:30)
- S IEN=0 D OBX^PSOORFI1,DIN^PSONFI(PSODRUG("OI"),$S($G(PSODRUG("IEN")):PSODRUG("IEN"),1:"")) ;Setup for N/F & DIN indicator
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="* (1) Orderable Item: "_$P(^PS(50.7,PSODRUG("OI"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")_NFIO
- S:NFIO["DIN" NFIO=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4)
- K LST S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (2) Drug: "_$S($G(PSODRUG("NAME"))]"":PSODRUG("NAME")_NFID,1:"No Dispense Drug Selected")
- S:NFID["DIN" NFID=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4)
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (3) Patient Status: "_$P($G(^PS(53,PSONEW("PATIENT STATUS"),0)),"^")
- S IEN=IEN+1,(PSOID,Y)=$E($P(OR0,"^",6),1,7) X ^DD("DD") S ^TMP("PSOPO",$J,IEN,0)=" (4) Issue Date: "_Y
- S (Y,PSONEW("FILL DATE"))=$E($P(OR0,"^",6),1,7) X ^DD("DD") S PSONEW("FILL DATE")=Y,^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_" (5) Fill Date: "_Y
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Instructions:" S TY=3 D INST^PSOORFI1
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (6) Possible SIG: " D:$G(PSONEW("SIG"))']"" SIG^PSOORFI1 S:$G(PSONEW("SIG"))]"" IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=$G(PSONEW("SIG")),IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=PSOERR("SIG")
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (7) Days Supply: "_$S($G(PSONEW("DAYS SUPPLY")):PSONEW("DAYS SUPPLY"),+$G(^PS(55,PSODFN,"PS"))&($P(^PS(53,+$G(^PS(55,PSODFN,"PS")),0),"^",3)):$P(^PS(53,+$G(^PS(55,PSODFN,"PS")),0),"^",3),1:"")
- S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_" (8) QTY: "_$P(OR0,"^",10)
- N PSOMWP S PSOMWP=$G(PSONEW("MAIL/WINDOW")) ;PAPI 441
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (9) # of Refills: "_$P(OR0,"^",11)_$E(" ",$L($P(OR0,"^",11))+1,2)_" (10) Routing: "_$S(PSOMWP="M":"MAIL",PSOMWP="P":"PARK",1:"WINDOW") ;PAPI 441
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (11) Clinic: "_PSORX("CLINIC")
- S $P(RN," ",32)=" ",IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (12) Provider: "_PSONEW("PROVIDER NAME")_$E(RN,$L(PSONEW("PROVIDER NAME"))+1,32)_" (13) Copies: "_$S($G(PSONEW("COPIES")):PSONEW("COPIES"),1:1) K RN
- I $P(^VA(200,$S($G(PSONEW("PROVIDER")):PSONEW("PROVIDER"),1:$P(OR0,"^",5)),"PS"),"^",7)&($P(^("PS"),"^",8)) S IEN=IEN+1,PSONEW("COSIGNING PROVIDER")=$P(^("PS"),"^",8) D
- .S ^TMP("PSOPO",$J,IEN,0)=" Cos-Provider: "_$P(^VA(200,+$G(PSONEW("COSIGNING PROVIDER")),0),"^")
- N LABEL S LABEL=" Provider Comments:" I $G(ORD),$$ERXIEN^PSOERXUT(ORD_"P") S LABEL=" eRx Prov. Comments:"
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=LABEL S TY=2 D INST^PSOORFI1
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (14) Remarks: "
- I $G(PSONEW("REMARKS"))]"" D
- .F SG=1:1:$L(PSONEW("REMARKS")) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(PSONEW("REMARKS")," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",20)=" " D
- ..S:$P(PSONEW("REMARKS")," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(PSONEW("REMARKS")," ",SG)
- S $P(RN," ",35)=" ",IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Entry By: "_$P(^VA(200,$P(OR0,"^",4),0),"^")_$E(RN,$L($P(^VA(200,$P(OR0,"^",4),0),"^"))+1,35)
- S Y=$P(OR0,"^",12) X ^DD("DD") S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_"Entry Date: "_$E($P(OR0,"^",12),4,5)_"/"_$E($P(OR0,"^",12),6,7)_"/"_$E($P(OR0,"^",12),2,3)_" "_$P(Y,"@",2) K RN
- G ^PSOLMPO
- Q
- DSPL ;backdoor
- K ^TMP("PSOPO",$J) D DIN^PSONFI(PSODRUG("OI"),$S($G(PSODRUG("IEN")):PSODRUG("IEN"),1:"")) ;NFI
- I $D(RX0),$D(PSODRUG("IEN")) D
- .;PSO*7.0*734: Delete check for $P(PSLST,",",2)
- .I PSODRUG("IEN")=$P(RX0,"^",6) D RST
- S IEN=0,IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Orderable Item: "_$P(^PS(50.7,PSODRUG("OI"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")_NFIO
- S:NFIO["DIN" NFIO=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4)
- I $G(PSODRUG("NAME"))]"" D G PST
- .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (1)"_$S($D(^PSDRUG("AQ",PSODRUG("IEN"))):" CMOP ",1:" ")_"Drug: "_PSODRUG("NAME")_NFID
- .S:NFID["DIN" NFID=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4)
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (1) Drug: No Dispense Drug Selected"
- PST S:$G(PSODRUG("TRADE NAME"))]"" IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Trade Name: "_$S($G(PSODRUG("TRADE NAME"))]"":PSODRUG("TRADE NAME"),1:"")
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (2) Patient Status: "_$P($G(^PS(53,PSONEW("PATIENT STATUS"),0)),"^")
- I $G(PSOID) S Y=PSOID X ^DD("DD") S PSONEW("ISSUE DATE")=Y
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (3) Issue Date: "_PSONEW("ISSUE DATE")
- S Y=PSONEW("FILL DATE") X ^DD("DD") S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_" (4) Fill Date: "_Y
- D DOSE^PSOBKDED
- I $G(PSORXED("IRXN")),'$G(PSOSIGFL) S RXN=PSORXED("IRXN") D:'$G(COPY) INST1^PSOORNE5 K RXN
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" SIG:"
- I $G(SIGOK),$O(SIG(0)) D SIG G DSP
- I $D(PSOCOPY),$G(PSONEW("SIG"))']"" D SIG G DSP
- I $G(PSOSIGFL),$G(PSONEW("SIG"))']"" D SIG G DSP
- D:$G(PSONEW("SIG"))]""
- .S X=PSONEW("SIG") D SIGONE^PSOHELP S SIG=$E($G(INS1),2,250)
- .F SG=1:1:$L(SIG) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(SIG," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",21)=" " S:$P(SIG," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(SIG," ",SG)
- DSP S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (7) Days Supply: "_PSONEW("DAYS SUPPLY")_$S($L(PSONEW("DAYS SUPPLY"))=1:" ",1:"")
- I '$D(PSONEW("FLD")),$D(RX0),'$G(PSOMTFLG) S PSONEW("QTY")=$S($G(PSONEW("QTY")):PSONEW("QTY"),1:$P(RX0,"^",7))
- ;if sched PSONEW("FLD") not def. qty reset
- ;if qty PSONEW("FLD")=7, qty NOT reset
- S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_" (8) QTY"_$S($G(PSODRUG("UNIT"))]"":" ("_PSODRUG("UNIT")_")",1:" ( )")_": "_PSONEW("QTY")
- I $P($G(^PSDRUG(+$G(PSODRUG("IEN")),5)),"^")]"" D
- .S $P(RN," ",79)=" ",IEN=IEN+1
- .S ^TMP("PSOPO",$J,IEN,0)=$E(RN,$L("QTY DSP MSG: "_$P(^PSDRUG(PSODRUG("IEN"),5),"^"))+1,79)_"QTY DSP MSG: "_$P(^PSDRUG(PSODRUG("IEN"),5),"^") K RN
- N PSOMWP S PSOMWP=$G(PSONEW("MAIL/WINDOW")) ;PAPI 441
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (9) # of Refills: "_PSONEW("# OF REFILLS")_$S($L(PSONEW("# OF REFILLS"))=1:" ",1:"")_" (10) Routing: "_$S(PSOMWP="M":"MAIL",PSOMWP="P":"PARK",1:"WINDOW") ;PAPI 441
- ;S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (9) # of Refills: "_PSONEW("# OF REFILLS")_$S($L(PSONEW("# OF REFILLS"))=1:" ",1:"")_" (10) Routing: "_$S($G(PSONEW("MAIL/WINDOW"))="M":"MAIL",1:"WINDOW")
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (11) Clinic: "_$S($G(PSONEW("CLINIC")):$P(^SC(PSONEW("CLINIC"),0),"^"),1:"")
- S $P(RN," ",31)=" ",IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (12) Provider: "_PSONEW("PROVIDER NAME")_$E(RN,$L(PSONEW("PROVIDER NAME"))+1,31)_"(13) Copies: "_$S($G(PSONEW("COPIES")):PSONEW("COPIES"),1:1) K RN
- ;*545 DEA/Detox exist then display
- I '$L($G(PSORX("RXDEA")))&($L($G(PSONEW("DEA")))) S PSORX("RXDEA")=PSONEW("DEA")
- I '$L($G(PSORX("DETX")))&($L($G(PSONEW("DETX")))) S PSORX("DETX")=PSONEW("DETX")
- I $L($G(PSORX("RXDEA"))) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" DEA#: "_PSORX("RXDEA") D
- . I $L($G(PSORX("DETX"))) S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_" DETOX#: "_PSORX("DETX")
- I $G(PKI),+$G(PSODRUG("DEA"))>1,+$G(PSODRUG("DEA"))<6 D PRV^PSOORFI5($G(PSONEW("PROVIDER")),$G(PSODRUG("IEN")),$P(OR0,"^"))
- I $G(PSONEW("COSIGNING PROVIDER"))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Cos-Provider: "_$P(^VA(200,PSONEW("COSIGNING PROVIDER"),0),"^")
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (14) Remarks:"
- I $G(PSONEW("REMARKS"))]"" D
- .F SG=1:1:$L(PSONEW("REMARKS")) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(PSONEW("REMARKS")," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",21)=" " D
- ..S:$P(PSONEW("REMARKS")," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(PSONEW("REMARKS")," ",SG)
- I $G(PSORXED("IRXN")),'$G(PSOSIGFL) S RXN=PSORXED("IRXN") D:'$G(COPY) PC1^PSOORNE5 K RXN
- S $P(RN," ",35)=" ",IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Entry By: "_$P(^VA(200,DUZ,0),"^")_$E(RN,$L($P(^VA(200,DUZ,0),"^"))+1,35)
- D NOW^%DTC S PSONEW("LOGIN DATE")=% K %,X S Y=PSONEW("LOGIN DATE") X ^DD("DD")
- S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_"Entry Date: "_$P(Y,"@")_" "_$P(Y,"@",2) K RN,PSOFDR
- S (VALMCNT,PSOPF)=IEN Q
- SIG ;
- D SIG^PSOORNE6 Q
- CMOP ;
- K PSXZ S X="PSXOPUTL" X ^%ZOSF("TEST") K X I D
- .S DA=RXN D ^PSXOPUTL K DA,PSOCMOP
- .S PSOCMOP=$S($G(PSXZ(PSXZ("L")))=0!($G(PSXZ(PSXZ("L")))=2):"Transmitted",$G(PSXZ(PSXZ("L")))=1:"Released",$G(PSXZ(PSXZ("L")))=3:"Not Dispensed",1:"")
- .I $G(PSXZ(PSXZ("L")))=3 F LBL=0:0 S LBL=$O(^PSRX(RXN,"L",LBL)) Q:'LBL I $P(^PSRX(RXN,"L",LBL,0),"^",2)=PSXZ("L"),'$P(^(0),"^",5),$P(^(0),"^",3)'["INTERACTION" S PSOCMOP="Local"
- .K PSXZ
- Q
- RST ;
- S PSODRUG("IEN")=$P(RX0,"^",6),PSODRUG("OI")=$P(^PSDRUG(($P(RX0,"^",6)),2),"^")
- S PSODRUG("NAME")=$P(^PSDRUG(($P(RX0,"^",6)),0),"^")
- Q
- RMK ;
- I $P(RX3,"^",7)]"" D
- .F SG=1:1:$L($P(RX3,"^",7)) S:$L(^TMP("PSOAO",$J,IEN,0)_" "_$P($P(RX3,"^",7)," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOAO",$J,IEN,0)," ",21)=" " D
- ..S:$P($P(RX3,"^",7)," ",SG)'="" ^TMP("PSOAO",$J,IEN,0)=$G(^TMP("PSOAO",$J,IEN,0))_" "_$P($P(RX3,"^",7)," ",SG)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOORNE3 10818 printed Jan 18, 2025@03:33:17 Page 2
- PSOORNE3 ;ISC-BHAM/SAB - display pending orders from backdoor ;Oct 20, 2022@15:30
- +1 ;;7.0;OUTPATIENT PHARMACY;**11,9,39,59,46,103,124,139,152,194,391,313,444,504,441,651,545,734**;DEC 1997;Build 10
- +2 ;Ext ref to ^SC (File #44) (DBIA 10040),^PSXOPUTL (DBIA 2200)
- +3 ;^PS(50.606 (DBIA 2174),^PS(50.7 DBIA 2223),^PS(55,DBIA 2228)
- +4 ;^PSDRUG (DBIA 221)
- +5 KILL ^TMP("PSOPO",$JOB)
- SET ORD=$PIECE(PSOLST(ORN),"^",2)
- DO ORD^PSOORFIN
- QUIT
- +6 SET PSODRUG("OI")=$PIECE(OR0,"^",8)
- SET PSODRUG("OIN")=$PIECE(^PS(50.7,$PIECE(OR0,"^",8),0),"^")
- +7 ;D POST^PSODRG
- IF $PIECE($GET(OR0),"^",9)
- SET DREN=$PIECE(OR0,"^",9)
- SET POERR=1
- DO DRG^PSOORDRG
- KILL POERR
- +8 IF '$PIECE(OR0,"^",9)
- DO DREN^PSOORNW2
- +9 SET PSONEW("# OF REFILLS")=$PIECE(OR0,"^",11)
- +10 SET (Y,PSONEW("ISSUE DATE"))=$SELECT($GET(PSONEW("ISSUE DATE")):PSONEW("ISSUE DATE"),1:$EXTRACT($PIECE(OR0,"^",6),1,7))
- XECUTE ^DD("DD")
- +11 SET PSONEW("CLERK CODE")=$PIECE(OR0,"^",4)
- SET PSORX("CLERK CODE")=$PIECE(^VA(200,$PIECE(OR0,"^",4),0),"^")
- +12 SET (PSONEW("DFLG"),PSONEW("QFLG"))=0
- SET PSODFN=$PIECE(OR0,"^",2)
- +13 IF '$GET(PSOMTFLG)
- SET PSONEW("QTY")=$SELECT($GET(PSONEW("QTY")):PSONEW("QTY"),1:$PIECE(OR0,"^",10))
- +14 SET PSONEW("MAIL/WINDOW")=$SELECT($PIECE(OR0,"^",17)]"":$PIECE(OR0,"^",17),1:"W")
- +15 if $GET(PSONEW("CLINIC"))']""
- SET PSONEW("CLINIC")=$PIECE(OR0,"^",13)
- +16 if $GET(PSORX("CLINIC"))']""
- SET PSORX("CLINIC")=$SELECT($DATA(^SC(+$PIECE(OR0,"^",13),0)):$PIECE(^SC($PIECE(OR0,"^",13),0),"^"),1:"")
- +17 SET PSONEW("CLERK CODE")=$PIECE(OR0,"^",4)
- SET PSONEW("PROVIDER")=$PIECE(OR0,"^",5)
- SET PSONEW("PROVIDER NAME")=$PIECE(^VA(200,$PIECE(OR0,"^",5),0),"^")
- +18 SET PSONEW("PATIENT STATUS")=$SELECT(+$GET(^PS(55,PSODFN,"PS")):+$GET(^PS(55,PSODFN,"PS")),1:"")
- +19 SET PSONEW("DAYS SUPPLY")=$SELECT(+$GET(^PS(55,PSODFN,"PS"))&($PIECE(^PS(53,+$GET(^PS(55,PSODFN,"PS")),0),"^",3)):$PIECE(^PS(53,+$GET(^PS(55,PSODFN,"PS")),0),"^",3),1:30)
- +20 ;Setup for N/F & DIN indicator
- SET IEN=0
- DO OBX^PSOORFI1
- DO DIN^PSONFI(PSODRUG("OI"),$SELECT($GET(PSODRUG("IEN")):PSODRUG("IEN"),1:""))
- +21 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)="* (1) Orderable Item: "_$PIECE(^PS(50.7,PSODRUG("OI"),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^")_NFIO
- +22 if NFIO["DIN"
- SET NFIO=IEN_","_($LENGTH(^TMP("PSOPO",$JOB,IEN,0))-4)
- +23 KILL LST
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (2) Drug: "_$SELECT($GET(PSODRUG("NAME"))]"":PSODRUG("NAME")_NFID,1:"No Dispense Drug Selected")
- +24 if NFID["DIN"
- SET NFID=IEN_","_($LENGTH(^TMP("PSOPO",$JOB,IEN,0))-4)
- +25 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (3) Patient Status: "_$PIECE($GET(^PS(53,PSONEW("PATIENT STATUS"),0)),"^")
- +26 SET IEN=IEN+1
- SET (PSOID,Y)=$EXTRACT($PIECE(OR0,"^",6),1,7)
- XECUTE ^DD("DD")
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (4) Issue Date: "_Y
- +27 SET (Y,PSONEW("FILL DATE"))=$EXTRACT($PIECE(OR0,"^",6),1,7)
- XECUTE ^DD("DD")
- SET PSONEW("FILL DATE")=Y
- SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_" (5) Fill Date: "_Y
- +28 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Instructions:"
- SET TY=3
- DO INST^PSOORFI1
- +29 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (6) Possible SIG: "
- if $GET(PSONEW("SIG"))']""
- DO SIG^PSOORFI1
- if $GET(PSONEW("SIG"))]""
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=$GET(PSONEW("SIG"))
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=PSOERR("SIG")
- +30 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (7) Days Supply: "_$SELECT($GET(PSONEW("DAYS SUPPLY")):PSONEW("DAYS SUPPLY"),+$GET(^PS(55,PSODFN,"PS"))&($PIECE(^PS(53,+$GET(^PS(55,PSODFN,"PS")),0),"^",3)):$PIECE(^PS(53,+$GET(^PS(55,PSODFN,"PS")),0),"^",3),1
- :"")
- +31 SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_" (8) QTY: "_$PIECE(OR0,"^",10)
- +32 ;PAPI 441
- NEW PSOMWP
- SET PSOMWP=$GET(PSONEW("MAIL/WINDOW"))
- +33 ;PAPI 441
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (9) # of Refills: "_$PIECE(OR0,"^",11)_$EXTRACT(" ",$LENGTH($PIECE(OR0,"^",11))+1,2)_" (10) Routing: "_$SELECT(PSOMWP="M":"MAIL",PSOMWP="P":"PARK",1:"WINDOW")
- +34 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (11) Clinic: "_PSORX("CLINIC")
- +35 SET $PIECE(RN," ",32)=" "
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (12) Provider: "_PSONEW("PROVIDER NAME")_$EXTRACT(RN,$LENGTH(PSONEW("PROVIDER NAME"))+1,32)_" (13) Copies: "_$SELECT($GET(PSONEW("COPIES")):PSONEW("COPIES"),1:1)
- KILL RN
- +36 IF $PIECE(^VA(200,$SELECT($GET(PSONEW("PROVIDER")):PSONEW("PROVIDER"),1:$PIECE(OR0,"^",5)),"PS"),"^",7)&($PIECE(^("PS"),"^",8))
- SET IEN=IEN+1
- SET PSONEW("COSIGNING PROVIDER")=$PIECE(^("PS"),"^",8)
- Begin DoDot:1
- +37 SET ^TMP("PSOPO",$JOB,IEN,0)=" Cos-Provider: "_$PIECE(^VA(200,+$GET(PSONEW("COSIGNING PROVIDER")),0),"^")
- End DoDot:1
- +38 NEW LABEL
- SET LABEL=" Provider Comments:"
- IF $GET(ORD)
- IF $$ERXIEN^PSOERXUT(ORD_"P")
- SET LABEL=" eRx Prov. Comments:"
- +39 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=LABEL
- SET TY=2
- DO INST^PSOORFI1
- +40 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (14) Remarks: "
- +41 IF $GET(PSONEW("REMARKS"))]""
- Begin DoDot:1
- +42 FOR SG=1:1:$LENGTH(PSONEW("REMARKS"))
- if $LENGTH(^TMP("PSOPO",$JOB,IEN,0)_" "_$PIECE(PSONEW("REMARKS")," ",SG))>80
- SET IEN=IEN+1
- SET $PIECE(^TMP("PSOPO",$JOB,IEN,0)," ",20)=" "
- Begin DoDot:2
- +43 if $PIECE(PSONEW("REMARKS")," ",SG)'=""
- SET ^TMP("PSOPO",$JOB,IEN,0)=$GET(^TMP("PSOPO",$JOB,IEN,0))_" "_$PIECE(PSONEW("REMARKS")," ",SG)
- End DoDot:2
- End DoDot:1
- +44 SET $PIECE(RN," ",35)=" "
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Entry By: "_$PIECE(^VA(200,$PIECE(OR0,"^",4),0),"^")_$EXTRACT(RN,$LENGTH($PIECE(^VA(200,$PIECE(OR0,"^",4),0),"^"))+1,35)
- +45 SET Y=$PIECE(OR0,"^",12)
- XECUTE ^DD("DD")
- SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_"Entry Date: "_$EXTRACT($PIECE(OR0,"^",12),4,5)_"/"_$EXTRACT($PIECE(OR0,"^",12),6,7)_"/"_$EXTRACT($PIECE(OR0,"^",12),2,3)_" "_$PIECE(Y,"@",2)
- KILL RN
- +46 GOTO ^PSOLMPO
- +47 QUIT
- DSPL ;backdoor
- +1 ;NFI
- KILL ^TMP("PSOPO",$JOB)
- DO DIN^PSONFI(PSODRUG("OI"),$SELECT($GET(PSODRUG("IEN")):PSODRUG("IEN"),1:""))
- +2 IF $DATA(RX0)
- IF $DATA(PSODRUG("IEN"))
- Begin DoDot:1
- +3 ;PSO*7.0*734: Delete check for $P(PSLST,",",2)
- +4 IF PSODRUG("IEN")=$PIECE(RX0,"^",6)
- DO RST
- End DoDot:1
- +5 SET IEN=0
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Orderable Item: "_$PIECE(^PS(50.7,PSODRUG("OI"),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^")_NFIO
- +6 if NFIO["DIN"
- SET NFIO=IEN_","_($LENGTH(^TMP("PSOPO",$JOB,IEN,0))-4)
- +7 IF $GET(PSODRUG("NAME"))]""
- Begin DoDot:1
- +8 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (1)"_$SELECT($DATA(^PSDRUG("AQ",PSODRUG("IEN"))):" CMOP ",1:" ")_"Drug: "_PSODRUG("NAME")_NFID
- +9 if NFID["DIN"
- SET NFID=IEN_","_($LENGTH(^TMP("PSOPO",$JOB,IEN,0))-4)
- End DoDot:1
- GOTO PST
- +10 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (1) Drug: No Dispense Drug Selected"
- PST if $GET(PSODRUG("TRADE NAME"))]""
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Trade Name: "_$SELECT($GET(PSODRUG("TRADE NAME"))]"":PSODRUG("TRADE NAME"),1:"")
- +1 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (2) Patient Status: "_$PIECE($GET(^PS(53,PSONEW("PATIENT STATUS"),0)),"^")
- +2 IF $GET(PSOID)
- SET Y=PSOID
- XECUTE ^DD("DD")
- SET PSONEW("ISSUE DATE")=Y
- +3 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (3) Issue Date: "_PSONEW("ISSUE DATE")
- +4 SET Y=PSONEW("FILL DATE")
- XECUTE ^DD("DD")
- SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_" (4) Fill Date: "_Y
- +5 DO DOSE^PSOBKDED
- +6 IF $GET(PSORXED("IRXN"))
- IF '$GET(PSOSIGFL)
- SET RXN=PSORXED("IRXN")
- if '$GET(COPY)
- DO INST1^PSOORNE5
- KILL RXN
- +7 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" SIG:"
- +8 IF $GET(SIGOK)
- IF $ORDER(SIG(0))
- DO SIG
- GOTO DSP
- +9 IF $DATA(PSOCOPY)
- IF $GET(PSONEW("SIG"))']""
- DO SIG
- GOTO DSP
- +10 IF $GET(PSOSIGFL)
- IF $GET(PSONEW("SIG"))']""
- DO SIG
- GOTO DSP
- +11 if $GET(PSONEW("SIG"))]""
- Begin DoDot:1
- +12 SET X=PSONEW("SIG")
- DO SIGONE^PSOHELP
- SET SIG=$EXTRACT($GET(INS1),2,250)
- +13 FOR SG=1:1:$LENGTH(SIG)
- if $LENGTH(^TMP("PSOPO",$JOB,IEN,0)_" "_$PIECE(SIG," ",SG))>80
- SET IEN=IEN+1
- SET $PIECE(^TMP("PSOPO",$JOB,IEN,0)," ",21)=" "
- if $PIECE(SIG," ",SG)'=""
- SET ^TMP("PSOPO",$JOB,IEN,0)=$GET(^TMP("PSOPO",$JOB,IEN,0))_" "_$PIECE(SIG," ",SG)
- End DoDot:1
- DSP SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (7) Days Supply: "_PSONEW("DAYS SUPPLY")_$SELECT($LENGTH(PSONEW("DAYS SUPPLY"))=1:" ",1:"")
- +1 IF '$DATA(PSONEW("FLD"))
- IF $DATA(RX0)
- IF '$GET(PSOMTFLG)
- SET PSONEW("QTY")=$SELECT($GET(PSONEW("QTY")):PSONEW("QTY"),1:$PIECE(RX0,"^",7))
- +2 ;if sched PSONEW("FLD") not def. qty reset
- +3 ;if qty PSONEW("FLD")=7, qty NOT reset
- +4 SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_" (8) QTY"_$SELECT($GET(PSODRUG("UNIT"))]"":" ("_PSODRUG("UNIT")_")",1:" ( )")_": "_PSONEW("QTY")
- +5 IF $PIECE($GET(^PSDRUG(+$GET(PSODRUG("IEN")),5)),"^")]""
- Begin DoDot:1
- +6 SET $PIECE(RN," ",79)=" "
- SET IEN=IEN+1
- +7 SET ^TMP("PSOPO",$JOB,IEN,0)=$EXTRACT(RN,$LENGTH("QTY DSP MSG: "_$PIECE(^PSDRUG(PSODRUG("IEN"),5),"^"))+1,79)_"QTY DSP MSG: "_$PIECE(^PSDRUG(PSODRUG("IEN"),5),"^")
- KILL RN
- End DoDot:1
- +8 ;PAPI 441
- NEW PSOMWP
- SET PSOMWP=$GET(PSONEW("MAIL/WINDOW"))
- +9 ;PAPI 441
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (9) # of Refills: "_PSONEW("# OF REFILLS")_$SELECT($LENGTH(PSONEW("# OF REFILLS"))=1:" ",1:"")_" (10) Routing: "_$SELECT(PSOMWP="M":"MAIL",PSOMWP="P":"PARK",1:"WINDOW")
- +10 ;S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (9) # of Refills: "_PSONEW("# OF REFILLS")_$S($L(PSONEW("# OF REFILLS"))=1:" ",1:"")_" (10) Routing: "_$S($G(PSONEW("MAIL/WINDOW"))="M":"MAIL",1:"WINDOW")
- +11 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (11) Clinic: "_$SELECT($GET(PSONEW("CLINIC")):$PIECE(^SC(PSONEW("CLINIC"),0),"^"),1:"")
- +12 SET $PIECE(RN," ",31)=" "
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (12) Provider: "_PSONEW("PROVIDER NAME")_$EXTRACT(RN,$LENGTH(PSONEW("PROVIDER NAME"))+1,31)_"(13) Copies: "_$SELECT($GET(PSONEW("COPIES")):PSONEW("COPIES"),1:1)
- KILL RN
- +13 ;*545 DEA/Detox exist then display
- +14 IF '$LENGTH($GET(PSORX("RXDEA")))&($LENGTH($GET(PSONEW("DEA"))))
- SET PSORX("RXDEA")=PSONEW("DEA")
- +15 IF '$LENGTH($GET(PSORX("DETX")))&($LENGTH($GET(PSONEW("DETX"))))
- SET PSORX("DETX")=PSONEW("DETX")
- +16 IF $LENGTH($GET(PSORX("RXDEA")))
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" DEA#: "_PSORX("RXDEA")
- Begin DoDot:1
- +17 IF $LENGTH($GET(PSORX("DETX")))
- SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_" DETOX#: "_PSORX("DETX")
- End DoDot:1
- +18 IF $GET(PKI)
- IF +$GET(PSODRUG("DEA"))>1
- IF +$GET(PSODRUG("DEA"))<6
- DO PRV^PSOORFI5($GET(PSONEW("PROVIDER")),$GET(PSODRUG("IEN")),$PIECE(OR0,"^"))
- +19 IF $GET(PSONEW("COSIGNING PROVIDER"))]""
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Cos-Provider: "_$PIECE(^VA(200,PSONEW("COSIGNING PROVIDER"),0),"^")
- +20 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (14) Remarks:"
- +21 IF $GET(PSONEW("REMARKS"))]""
- Begin DoDot:1
- +22 FOR SG=1:1:$LENGTH(PSONEW("REMARKS"))
- if $LENGTH(^TMP("PSOPO",$JOB,IEN,0)_" "_$PIECE(PSONEW("REMARKS")," ",SG))>80
- SET IEN=IEN+1
- SET $PIECE(^TMP("PSOPO",$JOB,IEN,0)," ",21)=" "
- Begin DoDot:2
- +23 if $PIECE(PSONEW("REMARKS")," ",SG)'=""
- SET ^TMP("PSOPO",$JOB,IEN,0)=$GET(^TMP("PSOPO",$JOB,IEN,0))_" "_$PIECE(PSONEW("REMARKS")," ",SG)
- End DoDot:2
- End DoDot:1
- +24 IF $GET(PSORXED("IRXN"))
- IF '$GET(PSOSIGFL)
- SET RXN=PSORXED("IRXN")
- if '$GET(COPY)
- DO PC1^PSOORNE5
- KILL RXN
- +25 SET $PIECE(RN," ",35)=" "
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Entry By: "_$PIECE(^VA(200,DUZ,0),"^")_$EXTRACT(RN,$LENGTH($PIECE(^VA(200,DUZ,0),"^"))+1,35)
- +26 DO NOW^%DTC
- SET PSONEW("LOGIN DATE")=%
- KILL %,X
- SET Y=PSONEW("LOGIN DATE")
- XECUTE ^DD("DD")
- +27 SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_"Entry Date: "_$PIECE(Y,"@")_" "_$PIECE(Y,"@",2)
- KILL RN,PSOFDR
- +28 SET (VALMCNT,PSOPF)=IEN
- QUIT
- SIG ;
- +1 DO SIG^PSOORNE6
- QUIT
- CMOP ;
- +1 KILL PSXZ
- SET X="PSXOPUTL"
- XECUTE ^%ZOSF("TEST")
- KILL X
- IF $TEST
- Begin DoDot:1
- +2 SET DA=RXN
- DO ^PSXOPUTL
- KILL DA,PSOCMOP
- +3 SET PSOCMOP=$SELECT($GET(PSXZ(PSXZ("L")))=0!($GET(PSXZ(PSXZ("L")))=2):"Transmitted",$GET(PSXZ(PSXZ("L")))=1:"Released",$GET(PSXZ(PSXZ("L")))=3:"Not Dispensed",1:"")
- +4 IF $GET(PSXZ(PSXZ("L")))=3
- FOR LBL=0:0
- SET LBL=$ORDER(^PSRX(RXN,"L",LBL))
- if 'LBL
- QUIT
- IF $PIECE(^PSRX(RXN,"L",LBL,0),"^",2)=PSXZ("L")
- IF '$PIECE(^(0),"^",5)
- IF $PIECE(^(0),"^",3)'["INTERACTION"
- SET PSOCMOP="Local"
- +5 KILL PSXZ
- End DoDot:1
- +6 QUIT
- RST ;
- +1 SET PSODRUG("IEN")=$PIECE(RX0,"^",6)
- SET PSODRUG("OI")=$PIECE(^PSDRUG(($PIECE(RX0,"^",6)),2),"^")
- +2 SET PSODRUG("NAME")=$PIECE(^PSDRUG(($PIECE(RX0,"^",6)),0),"^")
- +3 QUIT
- RMK ;
- +1 IF $PIECE(RX3,"^",7)]""
- Begin DoDot:1
- +2 FOR SG=1:1:$LENGTH($PIECE(RX3,"^",7))
- if $LENGTH(^TMP("PSOAO",$JOB,IEN,0)_" "_$PIECE($PIECE(RX3,"^",7)," ",SG))>80
- SET IEN=IEN+1
- SET $PIECE(^TMP("PSOAO",$JOB,IEN,0)," ",21)=" "
- Begin DoDot:2
- +3 if $PIECE($PIECE(RX3,"^",7)," ",SG)'=""
- SET ^TMP("PSOAO",$JOB,IEN,0)=$GET(^TMP("PSOAO",$JOB,IEN,0))_" "_$PIECE($PIECE(RX3,"^",7)," ",SG)
- End DoDot:2
- End DoDot:1
- +4 QUIT