PSOERSE3 ;ALB/RM - PSO ERX SINGLE ERX DISPLAY INIT section continuation ;Jan 30, 2024@12:43:34
;;7.0;OUTPATIENT PHARMACY;**746**;DEC 16, 1997;Build 106
;
Q
;
DISPRX ;continuation of PSOERSE2 routine
N VADRGNME
I "RR,CA,CN,IE"'[MTYPE!(MTYPE="N") D
. I MTYPE="RE",$$GET1^DIQ(52.49,PSOIEN,52.1,"I")'="R" Q
. S LINE=LINE+1 D SET^VALM10(LINE,"")
. S PSNF="" I $G(VADRGIEN) S PSNF=$S($P(^PSDRUG(VADRGIEN,0),"^",9):"***(N/F)***",1:"") ;p689
. S LINE=LINE+1
. S VADRGNME=VADRG_" "_$P($$VADRSCH^PSOERXUT(VADRGIEN),"^",3)_PSNF
. D SET^VALM10(LINE,"Vista Drug"_$S(DRMANVAL:"[v]",1:"")_": "_VADRGNME)
. D CNTRL^VALM10(LINE,$S(DRMANVAL:14,1:13),$L(VADRGNME),IOINHI,IOINORM)
. D ADDITEM^PSOERX1A(.LINETXT,"Vista Qty: ",$G(VAQTY),1,25)
. D ADDITEM^PSOERX1A(.LINETXT,"Vista Refills: ",$G(VAREF),27,18)
. D ADDITEM^PSOERX1A(.LINETXT,"Vista Days Supply: ",$G(VADAYS),54,22)
. S LINE=LINE+1 D SET^VALM10(LINE,LINETXT) S LINETXT=""
. D CNTRL^VALM10(LINE,12,$L(VAQTY),IOINHI,IOINORM)
. D CNTRL^VALM10(LINE,43,$L(VAREF),IOINHI,IOINORM)
. D CNTRL^VALM10(LINE,74,$L(VADAYS),IOINHI,IOINORM)
. S VASIG=""
. S SLOOP=0 F S SLOOP=$O(^PS(52.49,PSOIEN,"SIG",SLOOP)) Q:'SLOOP D
. . I '$L($G(VASIG)) S VASIG=$G(^PS(52.49,PSOIEN,"SIG",SLOOP,0)) Q
. . S VASIG=$G(VASIG)_" "_$G(^PS(52.49,PSOIEN,"SIG",SLOOP,0))
. D TXT2ARY^PSOERXD1(.VASARY,VASIG,,68)
. S FSSIG=$O(VASARY(0))
. S ERXDSUB=$$GET1^DIQ(52.49,PSOIEN,5.8,"I")
. S ERXDSUB=$S(ERXDSUB=1:"NO",ERXDSUB=0:"YES",1:"")
. S LINE=LINE+1 D SET^VALM10(LINE,"Substitutions?: "_ERXDSUB)
. I ERXDSUB'="" D CNTRL^VALM10(LINE,17,$L(ERXDSUB),IOINHI,IOINORM)
. S LINE=LINE+1 D SET^VALM10(LINE,"Vista Sig: "_$S(FSSIG:$G(VASARY(FSSIG)),1:""))
. I +FSSIG>0 D CNTRL^VALM10(LINE,12,$L(VASARY(FSSIG)),IOINHI,IOINORM)
. S SLOOP=1 F S SLOOP=$O(VASARY(SLOOP)) Q:'SLOOP D
. . S LINE=LINE+1 D SET^VALM10(LINE," "_VASARY(SLOOP)),CNTRL^VALM10(LINE,12,$L(VASARY(SLOOP)),IOINHI,IOINORM)
. S VPATINST=$$GET1^DIQ(52.49,PSOIEN,27,"E")
. I VPATINST]"" S VPATINST=$$LSIG^PSOQUTIL(VPATINST)
. D TXT2ARY^PSOERXD1(.VAPIARY,VPATINST," ",68)
. S FSVPIN=$O(VAPIARY(0))
. S LINE=LINE+1 D SET^VALM10(LINE," Pat Inst: "_$S(FSVPIN:$G(VAPIARY(FSVPIN)),1:""))
. I +FSVPIN>0 D CNTRL^VALM10(LINE,12,$L(VAPIARY(FSVPIN)),IOINHI,IOINORM)
. S VLOOP=1 F S VLOOP=$O(VAPIARY(VLOOP)) Q:'VLOOP D
. . S LINE=LINE+1 D SET^VALM10(LINE," "_VAPIARY(VLOOP)),CNTRL^VALM10(LINE,12,$L(VAPIARY(VLOOP)),IOINHI,IOINORM)
S ERXCOMM="eRx Notes: "_$$GET1^DIQ(52.49,PSOIEN,8,"E")
D TXT2ARY^PSOERXD1(.COMARY,ERXCOMM," ",68)
S COM=0 F S COM=$O(COMARY(COM)) Q:'COM D
. S LINE=LINE+1 D SET^VALM10(LINE,$G(COMARY(COM)))
. I COM=1 D CNTRL^VALM10(LINE,12,$L($G(COMARY(COM))),IOINHI,IOINORM) Q
. D CNTRL^VALM10(LINE,1,$L($G(COMARY(COM))),IOINHI,IOINORM)
I $$GET1^DIQ(52.49,PSOIEN,.05,"I") D
. D ALG(.LINE)
I '$G(S2017) D
. D DIAG^PSOERXU1(PSOIEN,.LINE)
I $G(S2017) D
. D:MEDIEN DIAG2017^PSOERXU5(PSOIEN,.LINE,,MEDIEN)
I $$GET1^DIQ(52.49,PSOIEN,95.1,"I") D
. D DEANOTE^PSOERX1H ; DEA Note for CS Digitally Signed eRx records
Q
;
ALG(LINE) ;
N ALGINFO,ALGLINE,DFN,IEN,XX,LDAT,GMRAL,PSONOAL,II,LDATA
S ALGLINE=""
S DFN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
D EN1^GMRADPT
S IEN=1
I 'GMRAL D
. S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)="Allergies: "_$S(GMRAL=0:"NKA",1:"")
. I GMRAL'=0 S PSONOAL="" D ALLERGY^PSOORUT2 I PSONOAL'="" S ^TMP("PSOPI",$J,IEN,0)="Allergies: "_PSONOAL K PSONOAL
. S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=" "
. D REMOTE^PSOORUT2
. S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)="Adverse Reactions:"
D:$G(GMRAL) ^PSOORUT3
S XX=0 F S XX=$O(^TMP("PSOPI",$J,XX)) Q:'XX D
. S LDAT=$G(^TMP("PSOPI",$J,XX,0))
. I $G(LDAT)=" " Q
. S LINE=LINE+1
. D SET^VALM10(LINE,LDAT)
. I $G(LDAT)["Allergies"!($G(LDAT)["Adverse Reactions") Q
. S LDAT=$S(LDAT[":":$P(LDAT,":",2),1:LDAT)
. D CNTRL^VALM10(LINE,15,$L(LDAT)+2,IOINHI,IOINORM)
K ^TMP("PSOPI",$J)
Q
;
DSPLYDUE(ERXIEN,LINE,DSPLYTO,TMPGL) ;Display the Prescriber Drug Use Evaluation
;Inputs: (r) ERXIEN - Pointer to the ERX HOLDING QUEUE file (#52.49)
; (r) LINE - List Manager line
; (o) DSPLYTO - Vista=0 (default), CPRS=1
; (o) TMPGL - The temporary global if the DUE is displayed in CPRS
;
N PDRGDUE,PDUEHDR,DUECNT,COAGENT,REASON,RESULT,ACK,PDUETOTAL,DDOT
I '+$G(DSPLYTO) S DSPLYTO=0
D PDUEDATA^PSOERXU9(.PDRGDUE,ERXIEN,1) ;1 means to display the DUE in alphabetical order
S PDUEHDR="Prescriber Drug Use Evaluation: "_$S('$D(PDRGDUE):"NONE",1:"")
S LINE=LINE+1
I '+$G(DSPLYTO) D SET^VALM10(LINE,PDUEHDR),CNTRL^VALM10(LINE,33,4,IOINHI,IOINORM)
E S @TMPGBL@(LINE,0)=PDUEHDR
;
I $D(PDRGDUE) D
. S PDUETOTAL=$O(PDRGDUE(""),-1)
. S $P(DDOT,".",81)=""
. S DUECNT=0 F S DUECNT=$O(PDRGDUE(DUECNT)) Q:'DUECNT D
. . K COAGENT,REASON,RESULT,ACK
. . S COAGENT="Co-Agent: "_$P(PDRGDUE(DUECNT),"^",8)
. . S REASON=$P(PDRGDUE(DUECNT),"^",2) I $$PRESOLV^PSOERXA1(REASON,"REA") S REASON=$$GET1^DIQ(52.45,$$PRESOLV^PSOERXA1(REASON,"REA"),.02)
. . S REASON="Reason: "_REASON
. . S RESULT=$P(PDRGDUE(DUECNT),"^",4) I $$PRESOLV^PSOERXA1(RESULT,"RES") S RESULT=$$GET1^DIQ(52.45,$$PRESOLV^PSOERXA1(RESULT,"RES"),.02)
. . S RESULT="Result: "_RESULT
. . S ACK="Override: "_$P(PDRGDUE(DUECNT),"^",9)
. . ;
. . I '+$G(DSPLYTO) D Q ;display the DUE in Vista
. . . S LINE=LINE+1 D SET^VALM10(LINE,COAGENT),CNTRL^VALM10(LINE,11,$L(COAGENT)+1,IOINHI,IOINORM)
. . . S LINE=LINE+1 D SET^VALM10(LINE,REASON),CNTRL^VALM10(LINE,9,$L(REASON)+1,IOINHI,IOINORM)
. . . S LINE=LINE+1 D SET^VALM10(LINE,RESULT),CNTRL^VALM10(LINE,9,$L(RESULT)+1,IOINHI,IOINORM)
. . . S LINE=LINE+1 D SET^VALM10(LINE,ACK),CNTRL^VALM10(LINE,17,$L(ACK)+1,IOINHI,IOINORM)
. . . I DUECNT'=+$G(PDUETOTAL) S LINE=LINE+1 D SET^VALM10(LINE,DDOT)
. . ;
. . ;display the DUE in CPRS Addendum
. . S LINE=LINE+1 S @TMPGBL@(LINE,0)=COAGENT
. . S LINE=LINE+1 S @TMPGBL@(LINE,0)=REASON
. . S LINE=LINE+1 S @TMPGBL@(LINE,0)=RESULT
. . S LINE=LINE+1 S @TMPGBL@(LINE,0)=ACK
. . I DUECNT'=+$G(PDUETOTAL) S LINE=LINE+1,@TMPGBL@(LINE,0)=DDOT
I +$G(DSPLYTO)=1 S LINE=LINE+1,@TMPGBL@(LINE,0)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERSE3 6193 printed Sep 15, 2024@21:51:59 Page 2
PSOERSE3 ;ALB/RM - PSO ERX SINGLE ERX DISPLAY INIT section continuation ;Jan 30, 2024@12:43:34
+1 ;;7.0;OUTPATIENT PHARMACY;**746**;DEC 16, 1997;Build 106
+2 ;
+3 QUIT
+4 ;
DISPRX ;continuation of PSOERSE2 routine
+1 NEW VADRGNME
+2 IF "RR,CA,CN,IE"'[MTYPE!(MTYPE="N")
Begin DoDot:1
+3 IF MTYPE="RE"
IF $$GET1^DIQ(52.49,PSOIEN,52.1,"I")'="R"
QUIT
+4 SET LINE=LINE+1
DO SET^VALM10(LINE,"")
+5 ;p689
SET PSNF=""
IF $GET(VADRGIEN)
SET PSNF=$SELECT($PIECE(^PSDRUG(VADRGIEN,0),"^",9):"***(N/F)***",1:"")
+6 SET LINE=LINE+1
+7 SET VADRGNME=VADRG_" "_$PIECE($$VADRSCH^PSOERXUT(VADRGIEN),"^",3)_PSNF
+8 DO SET^VALM10(LINE,"Vista Drug"_$SELECT(DRMANVAL:"[v]",1:"")_": "_VADRGNME)
+9 DO CNTRL^VALM10(LINE,$SELECT(DRMANVAL:14,1:13),$LENGTH(VADRGNME),IOINHI,IOINORM)
+10 DO ADDITEM^PSOERX1A(.LINETXT,"Vista Qty: ",$GET(VAQTY),1,25)
+11 DO ADDITEM^PSOERX1A(.LINETXT,"Vista Refills: ",$GET(VAREF),27,18)
+12 DO ADDITEM^PSOERX1A(.LINETXT,"Vista Days Supply: ",$GET(VADAYS),54,22)
+13 SET LINE=LINE+1
DO SET^VALM10(LINE,LINETXT)
SET LINETXT=""
+14 DO CNTRL^VALM10(LINE,12,$LENGTH(VAQTY),IOINHI,IOINORM)
+15 DO CNTRL^VALM10(LINE,43,$LENGTH(VAREF),IOINHI,IOINORM)
+16 DO CNTRL^VALM10(LINE,74,$LENGTH(VADAYS),IOINHI,IOINORM)
+17 SET VASIG=""
+18 SET SLOOP=0
FOR
SET SLOOP=$ORDER(^PS(52.49,PSOIEN,"SIG",SLOOP))
if 'SLOOP
QUIT
Begin DoDot:2
+19 IF '$LENGTH($GET(VASIG))
SET VASIG=$GET(^PS(52.49,PSOIEN,"SIG",SLOOP,0))
QUIT
+20 SET VASIG=$GET(VASIG)_" "_$GET(^PS(52.49,PSOIEN,"SIG",SLOOP,0))
End DoDot:2
+21 DO TXT2ARY^PSOERXD1(.VASARY,VASIG,,68)
+22 SET FSSIG=$ORDER(VASARY(0))
+23 SET ERXDSUB=$$GET1^DIQ(52.49,PSOIEN,5.8,"I")
+24 SET ERXDSUB=$SELECT(ERXDSUB=1:"NO",ERXDSUB=0:"YES",1:"")
+25 SET LINE=LINE+1
DO SET^VALM10(LINE,"Substitutions?: "_ERXDSUB)
+26 IF ERXDSUB'=""
DO CNTRL^VALM10(LINE,17,$LENGTH(ERXDSUB),IOINHI,IOINORM)
+27 SET LINE=LINE+1
DO SET^VALM10(LINE,"Vista Sig: "_$SELECT(FSSIG:$GET(VASARY(FSSIG)),1:""))
+28 IF +FSSIG>0
DO CNTRL^VALM10(LINE,12,$LENGTH(VASARY(FSSIG)),IOINHI,IOINORM)
+29 SET SLOOP=1
FOR
SET SLOOP=$ORDER(VASARY(SLOOP))
if 'SLOOP
QUIT
Begin DoDot:2
+30 SET LINE=LINE+1
DO SET^VALM10(LINE," "_VASARY(SLOOP))
DO CNTRL^VALM10(LINE,12,$LENGTH(VASARY(SLOOP)),IOINHI,IOINORM)
End DoDot:2
+31 SET VPATINST=$$GET1^DIQ(52.49,PSOIEN,27,"E")
+32 IF VPATINST]""
SET VPATINST=$$LSIG^PSOQUTIL(VPATINST)
+33 DO TXT2ARY^PSOERXD1(.VAPIARY,VPATINST," ",68)
+34 SET FSVPIN=$ORDER(VAPIARY(0))
+35 SET LINE=LINE+1
DO SET^VALM10(LINE," Pat Inst: "_$SELECT(FSVPIN:$GET(VAPIARY(FSVPIN)),1:""))
+36 IF +FSVPIN>0
DO CNTRL^VALM10(LINE,12,$LENGTH(VAPIARY(FSVPIN)),IOINHI,IOINORM)
+37 SET VLOOP=1
FOR
SET VLOOP=$ORDER(VAPIARY(VLOOP))
if 'VLOOP
QUIT
Begin DoDot:2
+38 SET LINE=LINE+1
DO SET^VALM10(LINE," "_VAPIARY(VLOOP))
DO CNTRL^VALM10(LINE,12,$LENGTH(VAPIARY(VLOOP)),IOINHI,IOINORM)
End DoDot:2
End DoDot:1
+39 SET ERXCOMM="eRx Notes: "_$$GET1^DIQ(52.49,PSOIEN,8,"E")
+40 DO TXT2ARY^PSOERXD1(.COMARY,ERXCOMM," ",68)
+41 SET COM=0
FOR
SET COM=$ORDER(COMARY(COM))
if 'COM
QUIT
Begin DoDot:1
+42 SET LINE=LINE+1
DO SET^VALM10(LINE,$GET(COMARY(COM)))
+43 IF COM=1
DO CNTRL^VALM10(LINE,12,$LENGTH($GET(COMARY(COM))),IOINHI,IOINORM)
QUIT
+44 DO CNTRL^VALM10(LINE,1,$LENGTH($GET(COMARY(COM))),IOINHI,IOINORM)
End DoDot:1
+45 IF $$GET1^DIQ(52.49,PSOIEN,.05,"I")
Begin DoDot:1
+46 DO ALG(.LINE)
End DoDot:1
+47 IF '$GET(S2017)
Begin DoDot:1
+48 DO DIAG^PSOERXU1(PSOIEN,.LINE)
End DoDot:1
+49 IF $GET(S2017)
Begin DoDot:1
+50 if MEDIEN
DO DIAG2017^PSOERXU5(PSOIEN,.LINE,,MEDIEN)
End DoDot:1
+51 IF $$GET1^DIQ(52.49,PSOIEN,95.1,"I")
Begin DoDot:1
+52 ; DEA Note for CS Digitally Signed eRx records
DO DEANOTE^PSOERX1H
End DoDot:1
+53 QUIT
+54 ;
ALG(LINE) ;
+1 NEW ALGINFO,ALGLINE,DFN,IEN,XX,LDAT,GMRAL,PSONOAL,II,LDATA
+2 SET ALGLINE=""
+3 SET DFN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
+4 DO EN1^GMRADPT
+5 SET IEN=1
+6 IF 'GMRAL
Begin DoDot:1
+7 SET IEN=IEN+1
SET ^TMP("PSOPI",$JOB,IEN,0)="Allergies: "_$SELECT(GMRAL=0:"NKA",1:"")
+8 IF GMRAL'=0
SET PSONOAL=""
DO ALLERGY^PSOORUT2
IF PSONOAL'=""
SET ^TMP("PSOPI",$JOB,IEN,0)="Allergies: "_PSONOAL
KILL PSONOAL
+9 SET IEN=IEN+1
SET ^TMP("PSOPI",$JOB,IEN,0)=" "
+10 DO REMOTE^PSOORUT2
+11 SET IEN=IEN+1
SET ^TMP("PSOPI",$JOB,IEN,0)="Adverse Reactions:"
End DoDot:1
+12 if $GET(GMRAL)
DO ^PSOORUT3
+13 SET XX=0
FOR
SET XX=$ORDER(^TMP("PSOPI",$JOB,XX))
if 'XX
QUIT
Begin DoDot:1
+14 SET LDAT=$GET(^TMP("PSOPI",$JOB,XX,0))
+15 IF $GET(LDAT)=" "
QUIT
+16 SET LINE=LINE+1
+17 DO SET^VALM10(LINE,LDAT)
+18 IF $GET(LDAT)["Allergies"!($GET(LDAT)["Adverse Reactions")
QUIT
+19 SET LDAT=$SELECT(LDAT[":":$PIECE(LDAT,":",2),1:LDAT)
+20 DO CNTRL^VALM10(LINE,15,$LENGTH(LDAT)+2,IOINHI,IOINORM)
End DoDot:1
+21 KILL ^TMP("PSOPI",$JOB)
+22 QUIT
+23 ;
DSPLYDUE(ERXIEN,LINE,DSPLYTO,TMPGL) ;Display the Prescriber Drug Use Evaluation
+1 ;Inputs: (r) ERXIEN - Pointer to the ERX HOLDING QUEUE file (#52.49)
+2 ; (r) LINE - List Manager line
+3 ; (o) DSPLYTO - Vista=0 (default), CPRS=1
+4 ; (o) TMPGL - The temporary global if the DUE is displayed in CPRS
+5 ;
+6 NEW PDRGDUE,PDUEHDR,DUECNT,COAGENT,REASON,RESULT,ACK,PDUETOTAL,DDOT
+7 IF '+$GET(DSPLYTO)
SET DSPLYTO=0
+8 ;1 means to display the DUE in alphabetical order
DO PDUEDATA^PSOERXU9(.PDRGDUE,ERXIEN,1)
+9 SET PDUEHDR="Prescriber Drug Use Evaluation: "_$SELECT('$DATA(PDRGDUE):"NONE",1:"")
+10 SET LINE=LINE+1
+11 IF '+$GET(DSPLYTO)
DO SET^VALM10(LINE,PDUEHDR)
DO CNTRL^VALM10(LINE,33,4,IOINHI,IOINORM)
+12 IF '$TEST
SET @TMPGBL@(LINE,0)=PDUEHDR
+13 ;
+14 IF $DATA(PDRGDUE)
Begin DoDot:1
+15 SET PDUETOTAL=$ORDER(PDRGDUE(""),-1)
+16 SET $PIECE(DDOT,".",81)=""
+17 SET DUECNT=0
FOR
SET DUECNT=$ORDER(PDRGDUE(DUECNT))
if 'DUECNT
QUIT
Begin DoDot:2
+18 KILL COAGENT,REASON,RESULT,ACK
+19 SET COAGENT="Co-Agent: "_$PIECE(PDRGDUE(DUECNT),"^",8)
+20 SET REASON=$PIECE(PDRGDUE(DUECNT),"^",2)
IF $$PRESOLV^PSOERXA1(REASON,"REA")
SET REASON=$$GET1^DIQ(52.45,$$PRESOLV^PSOERXA1(REASON,"REA"),.02)
+21 SET REASON="Reason: "_REASON
+22 SET RESULT=$PIECE(PDRGDUE(DUECNT),"^",4)
IF $$PRESOLV^PSOERXA1(RESULT,"RES")
SET RESULT=$$GET1^DIQ(52.45,$$PRESOLV^PSOERXA1(RESULT,"RES"),.02)
+23 SET RESULT="Result: "_RESULT
+24 SET ACK="Override: "_$PIECE(PDRGDUE(DUECNT),"^",9)
+25 ;
+26 ;display the DUE in Vista
IF '+$GET(DSPLYTO)
Begin DoDot:3
+27 SET LINE=LINE+1
DO SET^VALM10(LINE,COAGENT)
DO CNTRL^VALM10(LINE,11,$LENGTH(COAGENT)+1,IOINHI,IOINORM)
+28 SET LINE=LINE+1
DO SET^VALM10(LINE,REASON)
DO CNTRL^VALM10(LINE,9,$LENGTH(REASON)+1,IOINHI,IOINORM)
+29 SET LINE=LINE+1
DO SET^VALM10(LINE,RESULT)
DO CNTRL^VALM10(LINE,9,$LENGTH(RESULT)+1,IOINHI,IOINORM)
+30 SET LINE=LINE+1
DO SET^VALM10(LINE,ACK)
DO CNTRL^VALM10(LINE,17,$LENGTH(ACK)+1,IOINHI,IOINORM)
+31 IF DUECNT'=+$GET(PDUETOTAL)
SET LINE=LINE+1
DO SET^VALM10(LINE,DDOT)
End DoDot:3
QUIT
+32 ;
+33 ;display the DUE in CPRS Addendum
+34 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=COAGENT
+35 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=REASON
+36 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=RESULT
+37 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=ACK
+38 IF DUECNT'=+$GET(PDUETOTAL)
SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=DDOT
End DoDot:2
End DoDot:1
+39 IF +$GET(DSPLYTO)=1
SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=""
+40 QUIT
