- PSOORNE6 ;ISC-BHAM/SAB-display orders from backdoor ;5/23/05 2:08pm
- ;;7.0;OUTPATIENT PHARMACY;**46,103,117,156,210,488,505,508,617,769**;DEC 1997;Build 26
- ;External reference to MAIN^TIUEDIT is supported by DBIA 2410
- ;PSO*210 add call to WORDWRAP api
- ;
- SIG ;called from psoorne3
- I $G(PSOSIGFL)!$G(PSOCOPY)!($O(SIG(0))) G DOSE
- I '$P(^PSRX(PSORXED("IRXN"),"SIG"),"^",2) D Q
- .S X=$P(^PSRX(PSORXED("IRXN"),"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)
- F I=0:0 S I=$O(^PSRX(PSORXED("IRXN"),"SIG1",I)) Q:'I S MIG=$P(^PSRX(PSORXED("IRXN"),"SIG1",I,0),"^") D
- .S SIG(I)=MIG
- .F SG=1:1:$L(MIG) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(MIG," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",21)=" " S:$P(MIG," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(MIG," ",SG)
- .S SIGOK=1 K MIG,SG
- Q
- DOSE ;displays new SIG with dosing
- F I=0:0 S I=$O(SIG(I)) Q:'$D(SIG(+I)) D
- .F SG=1:1:$L(SIG(I)) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(SIG(I)," ",SG))>75 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",21)=" " S:$P(SIG(I)," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(SIG(I)," ",SG)
- S SIGOK=1 K MIG,I
- Q
- K1 ;
- K DRET,SIG,RTE,PRC,PHI,PSONOOR,PSOFDR,PSORXED,REF,DIR,DUOUT,DIRUT,SIGOK
- Q
- K2 ;
- K SIG,DRET,RTE,PRC,PHI,DIR,DIRUT,DTOUT,PSOOELSE,DUOUT,PSOFDR,SIGOK,PSORXED,REF,INS1,FDEDITED
- Q
- K3 ;
- K PSLST,ORD,IEN,ORN,RPH,ST,REFL,REF,PSOACT,ORSV,CC,CRIT,CT,DAYS,DDER,DEA,DSMSG,HDR,PSOAC,PSOFLAG,RFCNT
- K UPMI,RIFN,RX,RXDA,RXOR,RXREF,SEG1,SER,STA,PSOFDR,SIGOK,INCOM,PSONOOR,ACTREF,ACTREN,INS1,RX0,RX2,RX3
- Q
- ACP1 ;
- K REA,DA,MSG S REA="C",DA=PSONEW("OIRXN") S MSG="Renewed"_$S($G(PSOFDR):" from CPRS",1:"")
- ; PSO*7*508 added line to adjust MSG for renewal activity.
- N ERXIEN S ERXIEN=$$CHKERX^PSOERXU1($P($G(OR0),U)) I ERXIEN S MSG="Renewed by external provider (eRx)"
- S PSCAN(PSONEW("ORX #"))=DA_"^C" D CAN^PSOCAN,DCORD^PSONEW2 K REA,DA,MSG,PSCAN,RXXN
- S RXXN=$O(^TMP("PSORXN",$J,0)) I RXXN D
- .S RXN1=^TMP("PSORXN",$J,RXXN) D EN^PSOHLSN1(RXXN,$P(RXN1,"^"),$P(RXN1,"^",2),"",$P(RXN1,"^",3))
- .I $P(^PSRX(RXXN,"STA"),"^")=5 D EN^PSOHLSN1(RXXN,"SC","ZS",$P(RXN1,"^",4))
- .; PSO*7*508 - erx enhancement
- .N ERXFDA,ERXREQ
- .I ERXIEN D
- ..S ERXFDA(52.49,ERXIEN_",",.13)=RXXN D FILE^DIE(,"ERXFDA") K ERXFDA
- ..S ERXREQ=$$GETREQ^PSOERXU2(ERXIEN) I ERXREQ D UPDSTAT^PSOERXU1(ERXREQ,"RRC")
- ..D UPDSTAT^PSOERXU1(ERXIEN,"RXC")
- ..; Validates if the order is an eRx and Log Activity in AL eRx
- ..;D RXACT^PSOBPSU2(ERXIEN,0,"Renewed by external provider (eRx)","O")
- I $G(PSONOTE) D FULL^VALM1,MAIN^TIUEDIT(3,.TIUDA,PSODFN,"","","","",1) K PSONOTE
- K VERB,RTE,DRET,RXXN,RXN1,^TMP("PSORXN",$J)
- S BBRN="",BBRN1=$O(^PSRX("B",PSONEW("NRX #"),BBRN)) I $P($G(^PSRX(BBRN1,0)),"^",11)["W" S BINGCRT="Y",BINGRTE="W"
- Q
- INST ;formats instruction from front door
- I $O(^PSRX(RXN,"PI",0)) S PHI=^PSRX(RXN,"PI",0),T=0 D
- .F S T=$O(^PSRX(RXN,"PI",T)) Q:'T S PHI(T)=^PSRX(RXN,"PI",T,0)
- .S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Instructions:"
- .S T=0 F S T=$O(^PSRX(RXN,"PI",T)) Q:'T D ;PSO*210
- .. S MIG=^PSRX(RXN,"PI",T,0)
- .. D WORDWRAP^PSOUTLA2(MIG,.IEN,$NA(^TMP("PSOAO",$J)),21)
- K T,TY,MIG,SG
- Q
- PC ;displays provider comments
- I $O(^PSRX(RXN,"PRC",0)) S PRC=^PSRX(RXN,"PRC",0),T=0 D
- .F S T=$O(^PSRX(RXN,"PRC",T)) Q:'T S PRC(T)=^PSRX(RXN,"PRC",T,0)
- .S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Provider Comments:"
- .S T=0 F S T=$O(^PSRX(RXN,"PRC",T)) Q:'T D ;PSO*210
- .. S MIG=^PSRX(RXN,"PRC",T,0)
- .. D WORDWRAP^PSOUTLA2(MIG,.IEN,$NA(^TMP("PSOAO",$J)),21)
- K T,TY,MIG,SG
- Q
- INST1 ;formats instruction from front door
- I $O(^PSRX(RXN,"PI",0)) S PHI=^PSRX(RXN,"PI",0),T=0 D
- .F S T=$O(^PSRX(RXN,"PI",T)) Q:'T S PHI(T)=^PSRX(RXN,"PI",T,0)
- .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Instructions:"
- .S T=0 F S T=$O(^PSRX(RXN,"PI",T)) Q:'T D ;PSO*210
- .. S MIG=^PSRX(RXN,"PI",T,0)
- .. D WORDWRAP^PSOUTLA2(MIG,.IEN,$NA(^TMP("PSOPO",$J)),21)
- K T,TY,MIG,SG
- Q
- PC1 ;displays provider comments
- I $O(^PSRX(RXN,"PRC",0)) S PRC=^PSRX(RXN,"PRC",0),T=0 D
- .F S T=$O(^PSRX(RXN,"PRC",T)) Q:'T S PRC(T)=^PSRX(RXN,"PRC",T,0)
- .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Provider Comments:"
- .S T=0 F S T=$O(^PSRX(RXN,"PRC",T)) Q:'T D ;PSO*210
- .. S MIG=^PSRX(RXN,"PRC",T,0)
- .. D WORDWRAP^PSOUTLA2(MIG,.IEN,$NA(^TMP("PSOPO",$J)),21)
- K T,TY,MIG,SG
- Q
- ORCHK ;
- S (PSONEW("QFLG"),PSONEW("DFLG"))=0
- D FULL^VALM1 W !
- I $G(PSODRUG("NAME"))']"" D S:$D(DIRUT)!($G(PSODRUG("NAME"))']"") ACP=0 Q:$G(PSOQFLG)!($D(DIRUT))
- .W !,"DRUG NAME REQUIRED" D 2^PSOORNW1,FULL^VALM1 I $G(PSODRUG("NAME"))']"" S VALMSG="No Dispense Drug selected."
- S PSOMIS=$S($G(PSONEW("DOSE",1))']"":1,$G(PSONEW("SCHEDULE",1))']"":2,1:0)
- D:PSOMIS I PSODIR("DFLG")=1 S (PSONEW("QFLG"),POERR("DFLG"))=1 Q
- .W !!,"Incomplete Dosaging Instructions - "_$S(PSOMIS=2:"Schedule",1:"Dosage")_".",! S FDORC=1 D DOSE^PSOORED4(.PSONEW) K FDORC
- .I $G(PSONEW("DOSE",1))']""!($G(PSONEW("SCHEDULE",1))']"") S PSODIR("DFLG")=1 Q
- .D EN^PSOFSIG(.PSONEW) I PSONEW("ENT")>0,$O(SIG(0)) S (SIGOK,NEWDOSE)=1
- .D INS^PSODIR(.PSONEW),EN^PSOFSIG(.PSONEW)
- K PSOMIS,PSODOSE,POERR("DFLG"),PSONEW("QFLG") S I=0
- F S I=$O(PSONEW("DOSE",I)) Q:'I I $L(PSONEW("DOSE",I))>60 S (PSONEW("QFLG"),POERR("DFLG"))=1,PSODOSE("MSG",I)="Dosage #"_I_" is greater 60 characters in length!",VALMSG="Dosage Greater than 60 Characters, Please Edit!"
- I $G(POERR("DFLG"))=1 D K PSODOSE,I Q
- .S I=0 F S I=$O(PSODOSE("MSG",I)) Q:'I W !,PSODOSE("MSG",I)
- .H 3
- Q:$G(PSONEW("QFLG"))
- K PSONEW("FLD") F FLD="PATIENT STATUS^5","QTY^9","DAYS SUPPLY^8","# OF REFILLS^10","ISSUE DATE^6","FILL DATE^7","MAIL/WINDOW^11","PROVIDER NAME^13" D I $G(PSONEW($P(FLD,"^")))']"" S VALMBCK="R",PSONEW("FLD")=1
- .I $G(PSONEW($P(FLD,"^")))']"" W !,$P(FLD,"^")_" is required data" N RTN S RTN=$P(FLD,"^",2)_"^PSOORNEW" D @RTN K RTN
- Q:$G(PSONEW("DFLG"))=1
- QTY I PSONEW("QTY")'=+PSONEW("QTY"),PSONEW("QTY")'["." W !,"Quantity must be ALL numeric!",! D 9^PSOORNEW Q:$G(PSONEW("DFLG"))=1 G QTY
- I $G(PSODRUG("MAXDOSE"))]"",(PSONEW("QTY")/PSONEW("DAYS SUPPLY")>PSODRUG("MAXDOSE")) D Q:$G(PSONEW("DFLG"))=1!($G(PSONEW("QFLG"))) G QTY
- .W !,$C(7)," Greater than Maximum dose of "_PSODRUG("MAXDOSE")_" per day"
- .D KV^PSOVER1 S DIR(0)="Y",DIR("B")="Yes",DIR("A")="Do You Want to Edit Days Supply and Quantity Fields"
- .S DIR("?")="Enter 'Y' for Yes, 'N' for No, '^' to exit."
- .D ^DIR I $D(DIRUT) D KV^PSOVER1 K X,Y S (PSONEW("DFLG"),PSONEW("QFLG"))=1 Q ;*488
- .D KV^PSOVER1 I 'Y K X,Y Q
- .D 8^PSOORNEW Q:$G(PSONEW("DFLG")) D 9^PSOORNEW
- I $G(PSONEW("PROVIDER")) D PROV^PSOUTIL(.PSONEW) I $G(PSONEW("DFLG")) S PSODIR("DFLG")=1 Q
- S PSONEW("DFLG")=0 K DIC,X,Y
- Q
- DISP ;
- S:$P(RX2,"^",10)&('$G(PSOCOPY)) IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Verified By: "_$P(^VA(200,$P(RX2,"^",10),0),"^")
- I $P($G(^PSRX(RXN,"OR1")),"^",5) S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Finished By: "_$P(^VA(200,$P(^PSRX(RXN,"OR1"),"^",5),0),"^")
- I $P($G(^PSRX(RXN,"OR1")),"^",6) D
- .S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Filled By: "_$P(^VA(200,$P(^PSRX(RXN,"OR1"),"^",6),0),"^")
- I $P($G(^PSRX(RXN,"OR1")),"^",7) D
- .S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Checked By: "_$P(^VA(200,$P(^PSRX(RXN,"OR1"),"^",7),0),"^")
- S $P(RN," ",35)=" ",IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Entry By: "_$P(^VA(200,$P(RX0,"^",16),0),"^")_$E(RN,$L($P(^VA(200,$P(RX0,"^",16),0),"^"))+1,35)
- S Y=$P(RX2,"^") X ^DD("DD")
- S ^TMP("PSOAO",$J,IEN,0)=^TMP("PSOAO",$J,IEN,0)_"Entry Date: "_$E($P(RX2,"^"),4,5)_"/"_$E($P(RX2,"^"),6,7)_"/"_$E($P(RX2,"^"),2,3)_" "_$P(Y,"@",2) K RN
- S (VALMCNT,PSOPF)=IEN
- I $P($G(^PSRX(RXN,"PKI")),"^") S VALMSG="Digitally Signed Order"
- I $P($G(^PSRX(RXN,"PKI")),"^",3) S VALMSG="Digitally Signed eRx Order"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOORNE6 8040 printed Jan 18, 2025@03:33:20 Page 2
- PSOORNE6 ;ISC-BHAM/SAB-display orders from backdoor ;5/23/05 2:08pm
- +1 ;;7.0;OUTPATIENT PHARMACY;**46,103,117,156,210,488,505,508,617,769**;DEC 1997;Build 26
- +2 ;External reference to MAIN^TIUEDIT is supported by DBIA 2410
- +3 ;PSO*210 add call to WORDWRAP api
- +4 ;
- SIG ;called from psoorne3
- +1 IF $GET(PSOSIGFL)!$GET(PSOCOPY)!($ORDER(SIG(0)))
- GOTO DOSE
- +2 IF '$PIECE(^PSRX(PSORXED("IRXN"),"SIG"),"^",2)
- Begin DoDot:1
- +3 SET X=$PIECE(^PSRX(PSORXED("IRXN"),"SIG"),"^")
- DO SIGONE^PSOHELP
- SET SIG=$EXTRACT($GET(INS1),2,250)
- +4 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
- QUIT
- +5 FOR I=0:0
- SET I=$ORDER(^PSRX(PSORXED("IRXN"),"SIG1",I))
- if 'I
- QUIT
- SET MIG=$PIECE(^PSRX(PSORXED("IRXN"),"SIG1",I,0),"^")
- Begin DoDot:1
- +6 SET SIG(I)=MIG
- +7 FOR SG=1:1:$LENGTH(MIG)
- if $LENGTH(^TMP("PSOPO",$JOB,IEN,0)_" "_$PIECE(MIG," ",SG))>80
- SET IEN=IEN+1
- SET $PIECE(^TMP("PSOPO",$JOB,IEN,0)," ",21)=" "
- if $PIECE(MIG," ",SG)'=""
- SET ^TMP("PSOPO",$JOB,IEN,0)=$GET(^TMP("PSOPO",$JOB,IEN,0))_" "_$PIECE(MIG," ",SG)
- +8 SET SIGOK=1
- KILL MIG,SG
- End DoDot:1
- +9 QUIT
- DOSE ;displays new SIG with dosing
- +1 FOR I=0:0
- SET I=$ORDER(SIG(I))
- if '$DATA(SIG(+I))
- QUIT
- Begin DoDot:1
- +2 FOR SG=1:1:$LENGTH(SIG(I))
- if $LENGTH(^TMP("PSOPO",$JOB,IEN,0)_" "_$PIECE(SIG(I)," ",SG))>75
- SET IEN=IEN+1
- SET $PIECE(^TMP("PSOPO",$JOB,IEN,0)," ",21)=" "
- if $PIECE(SIG(I)," ",SG)'=""
- SET ^TMP("PSOPO",$JOB,IEN,0)=$GET(^TMP("PSOPO",$JOB,IEN,0))_" "_$PIECE(SIG(I)," ",SG)
- End DoDot:1
- +3 SET SIGOK=1
- KILL MIG,I
- +4 QUIT
- K1 ;
- +1 KILL DRET,SIG,RTE,PRC,PHI,PSONOOR,PSOFDR,PSORXED,REF,DIR,DUOUT,DIRUT,SIGOK
- +2 QUIT
- K2 ;
- +1 KILL SIG,DRET,RTE,PRC,PHI,DIR,DIRUT,DTOUT,PSOOELSE,DUOUT,PSOFDR,SIGOK,PSORXED,REF,INS1,FDEDITED
- +2 QUIT
- K3 ;
- +1 KILL PSLST,ORD,IEN,ORN,RPH,ST,REFL,REF,PSOACT,ORSV,CC,CRIT,CT,DAYS,DDER,DEA,DSMSG,HDR,PSOAC,PSOFLAG,RFCNT
- +2 KILL UPMI,RIFN,RX,RXDA,RXOR,RXREF,SEG1,SER,STA,PSOFDR,SIGOK,INCOM,PSONOOR,ACTREF,ACTREN,INS1,RX0,RX2,RX3
- +3 QUIT
- ACP1 ;
- +1 KILL REA,DA,MSG
- SET REA="C"
- SET DA=PSONEW("OIRXN")
- SET MSG="Renewed"_$SELECT($GET(PSOFDR):" from CPRS",1:"")
- +2 ; PSO*7*508 added line to adjust MSG for renewal activity.
- +3 NEW ERXIEN
- SET ERXIEN=$$CHKERX^PSOERXU1($PIECE($GET(OR0),U))
- IF ERXIEN
- SET MSG="Renewed by external provider (eRx)"
- +4 SET PSCAN(PSONEW("ORX #"))=DA_"^C"
- DO CAN^PSOCAN
- DO DCORD^PSONEW2
- KILL REA,DA,MSG,PSCAN,RXXN
- +5 SET RXXN=$ORDER(^TMP("PSORXN",$JOB,0))
- IF RXXN
- Begin DoDot:1
- +6 SET RXN1=^TMP("PSORXN",$JOB,RXXN)
- DO EN^PSOHLSN1(RXXN,$PIECE(RXN1,"^"),$PIECE(RXN1,"^",2),"",$PIECE(RXN1,"^",3))
- +7 IF $PIECE(^PSRX(RXXN,"STA"),"^")=5
- DO EN^PSOHLSN1(RXXN,"SC","ZS",$PIECE(RXN1,"^",4))
- +8 ; PSO*7*508 - erx enhancement
- +9 NEW ERXFDA,ERXREQ
- +10 IF ERXIEN
- Begin DoDot:2
- +11 SET ERXFDA(52.49,ERXIEN_",",.13)=RXXN
- DO FILE^DIE(,"ERXFDA")
- KILL ERXFDA
- +12 SET ERXREQ=$$GETREQ^PSOERXU2(ERXIEN)
- IF ERXREQ
- DO UPDSTAT^PSOERXU1(ERXREQ,"RRC")
- +13 DO UPDSTAT^PSOERXU1(ERXIEN,"RXC")
- +14 ; Validates if the order is an eRx and Log Activity in AL eRx
- +15 ;D RXACT^PSOBPSU2(ERXIEN,0,"Renewed by external provider (eRx)","O")
- End DoDot:2
- End DoDot:1
- +16 IF $GET(PSONOTE)
- DO FULL^VALM1
- DO MAIN^TIUEDIT(3,.TIUDA,PSODFN,"","","","",1)
- KILL PSONOTE
- +17 KILL VERB,RTE,DRET,RXXN,RXN1,^TMP("PSORXN",$JOB)
- +18 SET BBRN=""
- SET BBRN1=$ORDER(^PSRX("B",PSONEW("NRX #"),BBRN))
- IF $PIECE($GET(^PSRX(BBRN1,0)),"^",11)["W"
- SET BINGCRT="Y"
- SET BINGRTE="W"
- +19 QUIT
- INST ;formats instruction from front door
- +1 IF $ORDER(^PSRX(RXN,"PI",0))
- SET PHI=^PSRX(RXN,"PI",0)
- SET T=0
- Begin DoDot:1
- +2 FOR
- SET T=$ORDER(^PSRX(RXN,"PI",T))
- if 'T
- QUIT
- SET PHI(T)=^PSRX(RXN,"PI",T,0)
- +3 SET IEN=IEN+1
- SET ^TMP("PSOAO",$JOB,IEN,0)=" Instructions:"
- +4 ;PSO*210
- SET T=0
- FOR
- SET T=$ORDER(^PSRX(RXN,"PI",T))
- if 'T
- QUIT
- Begin DoDot:2
- +5 SET MIG=^PSRX(RXN,"PI",T,0)
- +6 DO WORDWRAP^PSOUTLA2(MIG,.IEN,$NAME(^TMP("PSOAO",$JOB)),21)
- End DoDot:2
- End DoDot:1
- +7 KILL T,TY,MIG,SG
- +8 QUIT
- PC ;displays provider comments
- +1 IF $ORDER(^PSRX(RXN,"PRC",0))
- SET PRC=^PSRX(RXN,"PRC",0)
- SET T=0
- Begin DoDot:1
- +2 FOR
- SET T=$ORDER(^PSRX(RXN,"PRC",T))
- if 'T
- QUIT
- SET PRC(T)=^PSRX(RXN,"PRC",T,0)
- +3 SET IEN=IEN+1
- SET ^TMP("PSOAO",$JOB,IEN,0)=" Provider Comments:"
- +4 ;PSO*210
- SET T=0
- FOR
- SET T=$ORDER(^PSRX(RXN,"PRC",T))
- if 'T
- QUIT
- Begin DoDot:2
- +5 SET MIG=^PSRX(RXN,"PRC",T,0)
- +6 DO WORDWRAP^PSOUTLA2(MIG,.IEN,$NAME(^TMP("PSOAO",$JOB)),21)
- End DoDot:2
- End DoDot:1
- +7 KILL T,TY,MIG,SG
- +8 QUIT
- INST1 ;formats instruction from front door
- +1 IF $ORDER(^PSRX(RXN,"PI",0))
- SET PHI=^PSRX(RXN,"PI",0)
- SET T=0
- Begin DoDot:1
- +2 FOR
- SET T=$ORDER(^PSRX(RXN,"PI",T))
- if 'T
- QUIT
- SET PHI(T)=^PSRX(RXN,"PI",T,0)
- +3 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Instructions:"
- +4 ;PSO*210
- SET T=0
- FOR
- SET T=$ORDER(^PSRX(RXN,"PI",T))
- if 'T
- QUIT
- Begin DoDot:2
- +5 SET MIG=^PSRX(RXN,"PI",T,0)
- +6 DO WORDWRAP^PSOUTLA2(MIG,.IEN,$NAME(^TMP("PSOPO",$JOB)),21)
- End DoDot:2
- End DoDot:1
- +7 KILL T,TY,MIG,SG
- +8 QUIT
- PC1 ;displays provider comments
- +1 IF $ORDER(^PSRX(RXN,"PRC",0))
- SET PRC=^PSRX(RXN,"PRC",0)
- SET T=0
- Begin DoDot:1
- +2 FOR
- SET T=$ORDER(^PSRX(RXN,"PRC",T))
- if 'T
- QUIT
- SET PRC(T)=^PSRX(RXN,"PRC",T,0)
- +3 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Provider Comments:"
- +4 ;PSO*210
- SET T=0
- FOR
- SET T=$ORDER(^PSRX(RXN,"PRC",T))
- if 'T
- QUIT
- Begin DoDot:2
- +5 SET MIG=^PSRX(RXN,"PRC",T,0)
- +6 DO WORDWRAP^PSOUTLA2(MIG,.IEN,$NAME(^TMP("PSOPO",$JOB)),21)
- End DoDot:2
- End DoDot:1
- +7 KILL T,TY,MIG,SG
- +8 QUIT
- ORCHK ;
- +1 SET (PSONEW("QFLG"),PSONEW("DFLG"))=0
- +2 DO FULL^VALM1
- WRITE !
- +3 IF $GET(PSODRUG("NAME"))']""
- Begin DoDot:1
- +4 WRITE !,"DRUG NAME REQUIRED"
- DO 2^PSOORNW1
- DO FULL^VALM1
- IF $GET(PSODRUG("NAME"))']""
- SET VALMSG="No Dispense Drug selected."
- End DoDot:1
- if $DATA(DIRUT)!($GET(PSODRUG("NAME"))']"")
- SET ACP=0
- if $GET(PSOQFLG)!($DATA(DIRUT))
- QUIT
- +5 SET PSOMIS=$SELECT($GET(PSONEW("DOSE",1))']"":1,$GET(PSONEW("SCHEDULE",1))']"":2,1:0)
- +6 if PSOMIS
- Begin DoDot:1
- +7 WRITE !!,"Incomplete Dosaging Instructions - "_$SELECT(PSOMIS=2:"Schedule",1:"Dosage")_".",!
- SET FDORC=1
- DO DOSE^PSOORED4(.PSONEW)
- KILL FDORC
- +8 IF $GET(PSONEW("DOSE",1))']""!($GET(PSONEW("SCHEDULE",1))']"")
- SET PSODIR("DFLG")=1
- QUIT
- +9 DO EN^PSOFSIG(.PSONEW)
- IF PSONEW("ENT")>0
- IF $ORDER(SIG(0))
- SET (SIGOK,NEWDOSE)=1
- +10 DO INS^PSODIR(.PSONEW)
- DO EN^PSOFSIG(.PSONEW)
- End DoDot:1
- IF PSODIR("DFLG")=1
- SET (PSONEW("QFLG"),POERR("DFLG"))=1
- QUIT
- +11 KILL PSOMIS,PSODOSE,POERR("DFLG"),PSONEW("QFLG")
- SET I=0
- +12 FOR
- SET I=$ORDER(PSONEW("DOSE",I))
- if 'I
- QUIT
- IF $LENGTH(PSONEW("DOSE",I))>60
- SET (PSONEW("QFLG"),POERR("DFLG"))=1
- SET PSODOSE("MSG",I)="Dosage #"_I_" is greater 60 characters in length!"
- SET VALMSG="Dosage Greater than 60 Characters, Please Edit!"
- +13 IF $GET(POERR("DFLG"))=1
- Begin DoDot:1
- +14 SET I=0
- FOR
- SET I=$ORDER(PSODOSE("MSG",I))
- if 'I
- QUIT
- WRITE !,PSODOSE("MSG",I)
- +15 HANG 3
- End DoDot:1
- KILL PSODOSE,I
- QUIT
- +16 if $GET(PSONEW("QFLG"))
- QUIT
- +17 KILL PSONEW("FLD")
- FOR FLD="PATIENT STATUS^5","QTY^9","DAYS SUPPLY^8","# OF REFILLS^10","ISSUE DATE^6","FILL DATE^7","MAIL/WINDOW^11","PROVIDER NAME^13"
- Begin DoDot:1
- +18 IF $GET(PSONEW($PIECE(FLD,"^")))']""
- WRITE !,$PIECE(FLD,"^")_" is required data"
- NEW RTN
- SET RTN=$PIECE(FLD,"^",2)_"^PSOORNEW"
- DO @RTN
- KILL RTN
- End DoDot:1
- IF $GET(PSONEW($PIECE(FLD,"^")))']""
- SET VALMBCK="R"
- SET PSONEW("FLD")=1
- +19 if $GET(PSONEW("DFLG"))=1
- QUIT
- QTY IF PSONEW("QTY")'=+PSONEW("QTY")
- IF PSONEW("QTY")'["."
- WRITE !,"Quantity must be ALL numeric!",!
- DO 9^PSOORNEW
- if $GET(PSONEW("DFLG"))=1
- QUIT
- GOTO QTY
- +1 IF $GET(PSODRUG("MAXDOSE"))]""
- IF (PSONEW("QTY")/PSONEW("DAYS SUPPLY")>PSODRUG("MAXDOSE"))
- Begin DoDot:1
- +2 WRITE !,$CHAR(7)," Greater than Maximum dose of "_PSODRUG("MAXDOSE")_" per day"
- +3 DO KV^PSOVER1
- SET DIR(0)="Y"
- SET DIR("B")="Yes"
- SET DIR("A")="Do You Want to Edit Days Supply and Quantity Fields"
- +4 SET DIR("?")="Enter 'Y' for Yes, 'N' for No, '^' to exit."
- +5 ;*488
- DO ^DIR
- IF $DATA(DIRUT)
- DO KV^PSOVER1
- KILL X,Y
- SET (PSONEW("DFLG"),PSONEW("QFLG"))=1
- QUIT
- +6 DO KV^PSOVER1
- IF 'Y
- KILL X,Y
- QUIT
- +7 DO 8^PSOORNEW
- if $GET(PSONEW("DFLG"))
- QUIT
- DO 9^PSOORNEW
- End DoDot:1
- if $GET(PSONEW("DFLG"))=1!($GET(PSONEW("QFLG")))
- QUIT
- GOTO QTY
- +8 IF $GET(PSONEW("PROVIDER"))
- DO PROV^PSOUTIL(.PSONEW)
- IF $GET(PSONEW("DFLG"))
- SET PSODIR("DFLG")=1
- QUIT
- +9 SET PSONEW("DFLG")=0
- KILL DIC,X,Y
- +10 QUIT
- DISP ;
- +1 if $PIECE(RX2,"^",10)&('$GET(PSOCOPY))
- SET IEN=IEN+1
- SET ^TMP("PSOAO",$JOB,IEN,0)=" Verified By: "_$PIECE(^VA(200,$PIECE(RX2,"^",10),0),"^")
- +2 IF $PIECE($GET(^PSRX(RXN,"OR1")),"^",5)
- SET IEN=IEN+1
- SET ^TMP("PSOAO",$JOB,IEN,0)=" Finished By: "_$PIECE(^VA(200,$PIECE(^PSRX(RXN,"OR1"),"^",5),0),"^")
- +3 IF $PIECE($GET(^PSRX(RXN,"OR1")),"^",6)
- Begin DoDot:1
- +4 SET IEN=IEN+1
- SET ^TMP("PSOAO",$JOB,IEN,0)=" Filled By: "_$PIECE(^VA(200,$PIECE(^PSRX(RXN,"OR1"),"^",6),0),"^")
- End DoDot:1
- +5 IF $PIECE($GET(^PSRX(RXN,"OR1")),"^",7)
- Begin DoDot:1
- +6 SET IEN=IEN+1
- SET ^TMP("PSOAO",$JOB,IEN,0)=" Checked By: "_$PIECE(^VA(200,$PIECE(^PSRX(RXN,"OR1"),"^",7),0),"^")
- End DoDot:1
- +7 SET $PIECE(RN," ",35)=" "
- SET IEN=IEN+1
- SET ^TMP("PSOAO",$JOB,IEN,0)=" Entry By: "_$PIECE(^VA(200,$PIECE(RX0,"^",16),0),"^")_$EXTRACT(RN,$LENGTH($PIECE(^VA(200,$PIECE(RX0,"^",16),0),"^"))+1,35)
- +8 SET Y=$PIECE(RX2,"^")
- XECUTE ^DD("DD")
- +9 SET ^TMP("PSOAO",$JOB,IEN,0)=^TMP("PSOAO",$JOB,IEN,0)_"Entry Date: "_$EXTRACT($PIECE(RX2,"^"),4,5)_"/"_$EXTRACT($PIECE(RX2,"^"),6,7)_"/"_$EXTRACT($PIECE(RX2,"^"),2,3)_" "_$PIECE(Y,"@",2)
- KILL RN
- +10 SET (VALMCNT,PSOPF)=IEN
- +11 IF $PIECE($GET(^PSRX(RXN,"PKI")),"^")
- SET VALMSG="Digitally Signed Order"
- +12 IF $PIECE($GET(^PSRX(RXN,"PKI")),"^",3)
- SET VALMSG="Digitally Signed eRx Order"
- +13 QUIT