Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOERSE3

PSOERSE3.m

Go to the documentation of this file.
PSOERSE3 ;ALB/RM - PSO ERX SINGLE ERX DISPLAY INIT section continuation ;Jan 30, 2024@12:43:34
 ;;7.0;OUTPATIENT PHARMACY;**746,769**;DEC 16, 1997;Build 26
 ;
 Q
 ;
DISPRX ;continuation of PSOERSE2 routine
 N VADRGNME,ERXCOMM,SLOOP,VASIG,FSVPIN,COMARY,COM,FSSIG
 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($G(DRMANVAL):"[v]",1:"")_": "_VADRGNME)
 . D CNTRL^VALM10(LINE,$S($G(DRMANVAL):15,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^PSOERSE1(.LINE)  ; 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,11,$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