- PSOERSE4 ;ALB/RM - PSO ERX UTILITY ROUTINE ;Jan 23, 2023@12:43:34
- ;;7.0;OUTPATIENT PHARMACY;**746**;DEC 16, 1997;Build 106
- ;
- ;
- Q ;No Direct Call
- ;
- BUILDLST(TMPGBL,ERXIEN,PNCOMM) ;
- ;Input : TMPGBL - The temporary global location to store the eRx data
- ; Example: ^TMP("TIUP",$J)
- ; ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
- ; PNCOMM - Patient Progress Note Comment.
- ; Example. This is a sample eRx patient Progress Note.
- ;Output: Create/Build the eRx temporary global
- Q:'$G(ERXIEN)
- N PATIEN,PHARMIEN,PRVIEN,PHDAT,PATDAT,SUPDAT,PRVDAT,LINE,PRVLNM,PRVMI,PRVFN,EPAT,EPATDOB,VPATIEN,HARY,HL,PROHIBIT,ERXWRDT
- N VPATNM,VPATDOB,EPRVIEN,EPRVNM,EPRVNPI,EPRVDEA,VAPRVIEN,VAPRVNM,VAPRVNPI,VAPRVDEA,SUPIEN,ERXDRUG,ERXQTY,ERXFLS,CSCOMM,MEDIEN
- N ERXDS,ERXDT,VADRGIEN,VADRG,LINETXT,ERXCOMM,ERXRFLS,PATIENS,VAHREA,VAQTY,VAREF,VASIG,PATDAT,CURSTATE,CURSTATI,WDATE,RRNRXIEN
- N LHFOUND,LHMATCH,LHSTATI,VAPDEAEX,ERXCOMM,COMFRST,COMARY,SIGDATA,SIGLOOP,SFIRSPROT,SGLOOP,SIGARY,VADAYS,NRXIEN,ERXPNC,ERXPNARY,PNLOOP
- N SLOOP,VASIG,VASARY,FSSIG,VAHSTA,EDIRECT,VAHPER,PAMANVAL,DRMANVAL,PRMANVAL,VPATINST,VAPIARY,VLOOP,FSVPIN,S2017,NEWRXIEN
- N DRGARY,DLP,MTYPE,MTYPEE,ERXSTAT,STATIEN,PDIAGTXT,SDIAGTXT,RELIEN,RELMTYPE,ERRIEN,LERXSTAT,LOPSTAT,OPIEN,ERXDSUB,COM,EXSTATUS,R2017,REQIEN
- N SFIRST,PATPT,EPRVPT,CIEN,CHGMESRI,CHGMESRQ,NO311,RESPVAL,ERRFLG,PSNF,ERXPNAME,ERXRFNUM,LINE,HTWT,DDASH
- ;
- K @TMPGBL ;This variable needs to be new'ed in the calling routine
- S LINE=0 ;LINE here serves as the counter
- S ERXPNAME=$$GET1^DIQ(52.49,ERXIEN,.04,"E")
- S ERXRFNUM=$$GET1^DIQ(52.49,ERXIEN,.01,"E")
- S LINE=LINE+1 S @TMPGBL@(LINE,0)="eRx Patient: "_ERXPNAME
- S LINE=LINE+1 S @TMPGBL@(LINE,0)="eRx Reference #: "_ERXRFNUM
- S HTWT=$$BHW^PSOERXIU(ERXIEN)
- S LINE=LINE+1 S @TMPGBL@(LINE,0)=HTWT
- S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
- ; set the standard field
- S S2017=$$GET1^DIQ(52.49,ERXIEN,312.1,"I")
- S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
- S MTYPEE=$$GET1^DIQ(52.49,ERXIEN,.08,"E")
- S STATIEN=$$GET1^DIQ(52.49,ERXIEN,1,"I")
- S ERXSTAT=$$GET1^DIQ(52.49,ERXIEN,1)_" - "_$$GET1^DIQ(52.45,$$GET1^DIQ(52.49,ERXIEN,1,"I"),.02)
- I MTYPE'="IE" S ERRFLG=0
- S PATIEN=$$GET1^DIQ(52.49,ERXIEN,.04,"I") I 'PATIEN S PATIEN=$$GETPAT^PSOERXU5(ERXIEN)
- S PATIENS=PATIEN_","
- D GETS^DIQ(52.46,PATIENS,"**","IE","PATDAT")
- I 'ERRFLG D
- . S EPAT=$G(PATDAT(52.46,PATIENS,.01,"E"))
- . S EPATDOB=$G(PATDAT(52.46,PATIENS,.08,"I")),EPATDOB=$$FMTE^XLFDT(EPATDOB,"2D")
- I ERRFLG D
- . S (EPAT,EPATDOB)=""
- S VPATIEN=$$GET1^DIQ(52.49,ERXIEN,.05,"I")
- S VPATNM=$S(VPATIEN&'ERRFLG:$$GET1^DIQ(2,VPATIEN,.01,"E"),1:"NOT LINKED")
- S VPATDOB=$S(VPATIEN&'ERRFLG:$$GET1^DIQ(2,VPATIEN,.03,"I"),1:"N/A")
- I VPATDOB S VPATDOB=$$FMTE^XLFDT(VPATDOB,"2D")
- S PHARMIEN=$$GET1^DIQ(52.49,ERXIEN,2.5,"I")
- D GETS^DIQ(52.47,PHARMIEN,"**","E","PHDAT")
- S EPRVIEN=$$GET1^DIQ(52.49,ERXIEN,2.1,"I") I 'EPRVIEN S EPRVIEN=$$GETPROV^PSOERXU5(ERXIEN)
- S EPRVNM=$$GET1^DIQ(52.48,EPRVIEN,.01,"E")
- ; erx provider primary phone 2017071
- I S2017 D
- . S EPRVPT=$$COMMVAL^PSOERXU5(EPRVIEN,52.48,11,"PT",1)
- I 'S2017 D
- . N IENS,TYPE,EXT
- . S EPRVPT="",CIEN=$O(^PS(52.48,EPRVIEN,3,"C","TE",0))
- . I CIEN D
- . . S IENS=CIEN_","_EPRVIEN_","
- . . S EPRVPT=$$GET1^DIQ(52.483,IENS,.01,"I")
- . I 'CIEN D
- . . S CIEN=0
- . . F S CIEN=$O(^PS(52.48,EPRVIEN,3,CIEN)) Q:CIEN'?1.N D Q:EPRVPT]""
- . . . S IENS=CIEN_","_EPRVIEN_","
- . . . S EPRVPT=$$GET1^DIQ(52.483,IENS,.01,"I")
- . . . S TYPE=$$GET1^DIQ(52.483,IENS,.02,"I")
- . . . S:TYPE="EM" EPRVPT=""
- . I EPRVPT]"" D
- . . S EXT=$$GET1^DIQ(52.483,IENS,.03,"I")
- . . S:EXT]"" EPRVPT=EPRVPT_"X"_EXT
- I 'S2017 S EPRVNPI=$$GET1^DIQ(52.48,EPRVIEN,1.5,"E")
- I S2017 S EPRVNPI=$$GET1^DIQ(52.48,EPRVIEN,15.1,"E")
- S EPRVDEA=$$GET1^DIQ(52.48,EPRVIEN,1.6,"E")
- S VAPRVIEN=$$GET1^DIQ(52.49,ERXIEN,2.3,"I")
- S ERXWRDT=$$GET1^DIQ(52.49,ERXIEN,5.9,"I")
- S VAPRVNM=$S(VAPRVIEN:$$GET1^DIQ(200,VAPRVIEN,.01,"E"),1:"NOT LINKED")
- S VAPRVNPI=$S(VAPRVIEN:$$GET1^DIQ(200,VAPRVIEN,41.99,"E"),1:"N/A")
- S VAPRVDEA=$S(VAPRVIEN:$$DEA^XUSER(0,VAPRVIEN,ERXWRDT),1:"N/A")
- D GETS^DIQ(52.48,EPRVIEN,"**","E","PRVDAT")
- S SUPIEN=$$GET1^DIQ(52.49,ERXIEN,2.6,"I")
- D GETS^DIQ(52.48,SUPIEN,"**","E","SUPDAT")
- S PAMANVAL=$$GET1^DIQ(52.49,ERXIEN,1.7,"I")
- S PRMANVAL=$$GET1^DIQ(52.49,ERXIEN,1.3,"I")
- S DRMANVAL=$$GET1^DIQ(52.49,ERXIEN,1.5,"I")
- S WDATE=$$GET1^DIQ(52.49,ERXIEN,5.9,"E")
- S CHGMESRQ=$$GET1^DIQ(52.49,ERXIEN,315.1,"I")
- S CHGMESRI=$$GET1^DIQ(52.45,CHGMESRQ,.01,"I")
- S RESPVAL=$$GET1^DIQ(52.49,ERXIEN,52.1,"E")
- S:'ERRFLG PATPT=$$GETPTPH^PSOERXU7(PATIEN,S2017,"PT,HP")
- ; only set the hold reason if the eRx has a hold status
- S CURSTATE=$$GET1^DIQ(52.49,ERXIEN,1,"E")
- S (VAHSTA,VAHREA)=""
- I S2017,MTYPE'="RE" D
- . S MEDIEN=$O(^PS(52.49,ERXIEN,311,"C","P",0))
- . S EDIRECT=$$GET1^DIQ(52.49,MEDIEN_","_ERXIEN_",",8,"E")
- . I $G(MEDIEN) S ERXPNC=$$GET1^DIQ(52.49311,MEDIEN_","_ERXIEN_",",5) ;retrieved provider notes/comments
- I S2017,MTYPE="RE" D
- . S MEDIEN=$O(^PS(52.49,ERXIEN,311,"C","MR",0))
- I 'S2017 D
- . S EDIRECT=$$GET1^DIQ(52.49,ERXIEN,7,"E")
- I $E(CURSTATE,1)="H" D
- . S CURSTATI=$$GET1^DIQ(52.49,ERXIEN,1,"I")
- . S LHMATCH=999999,LHFOUND=0 F S LHMATCH=$O(^PS(52.49,ERXIEN,19,LHMATCH),-1) Q:'LHMATCH!(LHFOUND) D
- . . S LHSTATI=$$GET1^DIQ(52.4919,LHMATCH_","_ERXIEN_",",.02,"I") I LHSTATI=CURSTATI D S LHFOUND=LHMATCH Q
- . . . S VAHREA=$$GET1^DIQ(52.4919,LHMATCH_","_ERXIEN_",",1)
- . . . S VAHSTA=$$GET1^DIQ(52.45,LHSTATI,.01,"E")_" - "_$$GET1^DIQ(52.45,LHSTATI,.02,"E")
- . . . S VAHPER=$$GET1^DIQ(52.4919,LHMATCH_","_ERXIEN_",",.03,"E")
- I (",RE,CN,"[(","_MTYPE_","))!((MTYPE="CX")&$$CHGMTYPE^PSOERX1D(ERXIEN,MTYPE,RESPVAL,CHGMESRI)) S MTYPEE=$G(MTYPEE)_" - "_$$GET1^DIQ(52.49,ERXIEN,52.1,"E")
- S LINETXT=""
- I $$GET1^DIQ(52.49,ERXIEN,95.1,"I") S $E(MTYPEE,63)="EPCS DEA VALIDATED"
- S LINE=LINE+1 S @TMPGBL@(LINE,0)=MTYPEE
- S LINE=LINE+1 S @TMPGBL@(LINE,0)="eRx Status: "_$S($E(CURSTATE,1)="H":VAHSTA,1:ERXSTAT)
- I ",CX,CR,"[(","_MTYPE_","),$$QTSUMDT1^PSOERSE5(TMPGBL,ERXIEN,MTYPE,CHGMESRI,CHGMESRQ,RESPVAL,.LINE) D Q
- . I ",CR,"[(","_MTYPE_",") D ADDPNOTE^PSOERX1H(.LINE,$G(PNCOMM))
- ;
- I $G(CSCOMM)]"" S LINE=LINE+1 S @TMPGBL@(LINE,0)="Current Status Details: "_CSCOMM
- I $D(LERXSTAT) S LINE=LINE+1 S @TMPGBL@(LINE,0)="Last New Rx status: "_LERXSTAT
- I $D(LOPSTAT) S LINE=LINE+1 S @TMPGBL@(LINE,0)="Outpatient Prescription status: "_LOPSTAT
- I @TMPGBL@(LINE,0)'="" S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
- S LINE=LINE+1 S @TMPGBL@(LINE,0)="**************************MEDICATION PRESCRIBED******************************"
- I 'ERRFLG,$L($G(PATPT)) S LINE=LINE+1 S @TMPGBL@(LINE,0)="eRx Patient Primary Telephone: "_PATPT
- S LINE=LINE+1
- D ADDITEM^PSOERX1A(.LINETXT,"eRx Patient: ",EPAT,1,52)
- D ADDITEM^PSOERX1A(.LINETXT,"DOB: ",EPATDOB,57,20)
- S @TMPGBL@(LINE,0)=LINETXT S LINETXT=""
- S LINE=LINE+1
- I $L($G(EPRVPT)) S LINE=LINE+1 S @TMPGBL@(LINE,0)="eRx Provider Primary Telephone: "_EPRVPT
- S LINE=LINE+1
- D ADDITEM^PSOERX1A(.LINETXT,"eRx Provider: ",EPRVNM,1,52)
- S @TMPGBL@(LINE,0)=LINETXT S LINETXT=""
- D ADDITEM^PSOERX1A(.LINETXT,"DEA#: ",EPRVDEA,30,20)
- D ADDITEM^PSOERX1A(.LINETXT,"NPI: ",EPRVNPI,57,20)
- S LINE=LINE+1 S @TMPGBL@(LINE,0)=LINETXT S LINETXT=""
- S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
- S ERXDRUG=$$GET1^DIQ(52.49,ERXIEN,3.1,"E") I '$L(ERXDRUG) S ERXDRUG=$$GETDRUG^PSOERXU5(ERXIEN)
- S ERXQTY=$$GET1^DIQ(52.49,ERXIEN,5.1,"E")
- I $G(S2017) S ERXRFLS=$$GET1^DIQ(52.49,ERXIEN,5.6,"E")
- ;If the message type is 'CX' for RXCHANGERESPONSE, display the Prescriber Drug Use Evaluation.
- I MTYPE="CX" D DSPLYDUE^PSOERSE3(ERXIEN,.LINE,1,TMPGBL)
- ;setting 10.6 refill value
- I '$G(S2017) D
- . S ERXRFLS=$$GET1^DIQ(52.49,ERXIEN,5.6,"E")
- . I ERXRFLS="" S ERXRFLS=$$GET1^DIQ(52.49,ERXIEN,5.7,"I")
- S ERXDS=$$GET1^DIQ(52.49,ERXIEN,5.5,"E")
- S ERXDT=$$GET1^DIQ(52.49,ERXIEN,.03,"E")
- I S2017 D
- . S ERXDT=$S(MEDIEN:$$EFFDATE^PSOERXU5(ERXIEN,MEDIEN),1:"")
- S VADRGIEN=$$GET1^DIQ(52.49,ERXIEN,3.2,"I")
- S VADRG=$$GET1^DIQ(52.49,ERXIEN,3.2,"E")
- S VAREF=$$GET1^DIQ(52.49,ERXIEN,20.5,"E")
- S VAQTY=$$GET1^DIQ(52.49,ERXIEN,20.1,"E")
- S VADAYS=$$GET1^DIQ(52.49,ERXIEN,20.2,"E")
- I VADRG']"" S VADRG="NOT LINKED"
- D TXT2ARY^PSOERXD1(.DRGARY,ERXDRUG,,70)
- S LINE=LINE+1 S @TMPGBL@(LINE,0)="eRx Drug: "_$G(DRGARY(1))_" "_$P($$ERXDRSCH^PSOERXUT(ERXIEN),"^",2)
- S DLP=1
- F S DLP=$O(DRGARY(DLP)) Q:'DLP D
- . S LINE=LINE+1 S @TMPGBL@(LINE,0)=" "_$G(DRGARY(DLP))
- S LINE=LINE+1
- D ADDITEM^PSOERX1A(.LINETXT,"eRx Qty: ",ERXQTY,1,17)
- D ADDITEM^PSOERX1A(.LINETXT,"eRx Refills: ",ERXRFLS,19,16)
- D ADDITEM^PSOERX1A(.LINETXT,"eRx Days Supply: ",ERXDS,37,20)
- I 'S2017 D ADDITEM^PSOERX1A(.LINETXT,"eRx Date: ",$P(ERXDT,"@"),58,22)
- S @TMPGBL@(LINE,0)=LINETXT S LINETXT=""
- I S2017 D
- . S LINE=LINE+1
- . D ADDITEM^PSOERX1A(.LINETXT,"eRx Written Date: ",$P(WDATE,"@"),1,35)
- . D ADDITEM^PSOERX1A(.LINETXT,"eRx Issue Date: ",ERXDT,40,70)
- . S @TMPGBL@(LINE,0)=LINETXT S LINETXT=""
- . S LINE=LINE+1
- . I MTYPE="N"!((MTYPE="CX")&$$PROHIBIT^PSOERX1D(RESPVAL,CHGMESRI)) D
- . . S PROHIBIT=$$GET1^DIQ(52.49,ERXIEN,301.3,"I")
- . . S PROHIBIT=$S(PROHIBIT=1:"Yes",1:"No")
- . . S @TMPGBL@(LINE,0)="Prohibit Renewals: "_PROHIBIT
- D TXT2ARY^PSOERXD1(.SIGARY,$G(EDIRECT),,70)
- S SFIRST=$O(SIGARY(0))
- I 'S2017 D
- . S SGLOOP=0 F S SGLOOP=$O(SIGARY(SGLOOP)) Q:'SGLOOP D
- . . S LINE=LINE+1 S @TMPGBL@(LINE,0)=$S(SGLOOP=SFIRST:"eRx Sig: ",1:" ")_$G(SIGARY(SGLOOP))
- I S2017,$G(MEDIEN) D
- . S LINE=LINE+1 S @TMPGBL@(LINE,0)="eRx Sig: "
- . S SGLOOP=0 F S SGLOOP=$O(^PS(52.49,ERXIEN,311,MEDIEN,8,SGLOOP)) Q:'SGLOOP D
- . . I SGLOOP=1 S @TMPGBL@(LINE,0)=@TMPGBL@(LINE,0)_$G(^PS(52.49,ERXIEN,311,MEDIEN,8,SGLOOP,0)) Q
- . . S LINE=LINE+1 S @TMPGBL@(LINE,0)=$G(^PS(52.49,ERXIEN,311,MEDIEN,8,SGLOOP,0))
- . K ERXPNARY D TXT2ARY^PSOERXD1(.ERXPNARY,$G(ERXPNC),,80)
- . S LINE=LINE+1 S @TMPGBL@(LINE,0)="eRx Provider Notes/Comments:"
- . I $D(ERXPNARY) D
- . . S PNLOOP=0 F S PNLOOP=$O(ERXPNARY(PNLOOP)) Q:'PNLOOP D
- . . . S LINE=LINE+1 S @TMPGBL@(LINE,0)=$G(ERXPNARY(PNLOOP))
- I (",CX,CR,"[(","_MTYPE_",")),$$QTSUMDT2^PSOERSE5(TMPGBL,ERXIEN,MTYPE,CHGMESRI,RESPVAL,.LINE) D Q
- . I ",CR,"[(","_MTYPE_",") D ADDPNOTE^PSOERX1H(.LINE,$G(PNCOMM))
- ;
- DISPRX ;
- I "RR,CA,CN,IE"'[MTYPE!(MTYPE="N") D
- . I MTYPE="RE",$$GET1^DIQ(52.49,ERXIEN,52.1,"I")'="R" Q
- . S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
- . S PSNF="" I $G(VADRGIEN) S PSNF=$S($P(^PSDRUG(VADRGIEN,0),"^",9):"***(N/F)***",1:"") ;p689
- . S LINE=LINE+1 S @TMPGBL@(LINE,0)="Vista Drug"_$S(DRMANVAL:"[v]",1:"")_": "_VADRG_" "_$P($$VADRSCH^PSOERXUT(VADRGIEN),"^",3)_PSNF
- . S LINE=LINE+1
- . 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 @TMPGBL@(LINE,0)=LINETXT S LINETXT=""
- . S VASIG=""
- . S SLOOP=0 F S SLOOP=$O(^PS(52.49,ERXIEN,"SIG",SLOOP)) Q:'SLOOP D
- . . I '$L($G(VASIG)) S VASIG=$G(^PS(52.49,ERXIEN,"SIG",SLOOP,0)) Q
- . . S VASIG=$G(VASIG)_" "_$G(^PS(52.49,ERXIEN,"SIG",SLOOP,0))
- . D TXT2ARY^PSOERXD1(.VASARY,VASIG,,68)
- . S FSSIG=$O(VASARY(0))
- . S ERXDSUB=$$GET1^DIQ(52.49,ERXIEN,5.8,"I")
- . S ERXDSUB=$S(ERXDSUB=1:"NO",ERXDSUB=0:"YES",1:"")
- . S LINE=LINE+1 S @TMPGBL@(LINE,0)="Substitutions? :"_ERXDSUB
- . S LINE=LINE+1 S @TMPGBL@(LINE,0)="Vista Sig: "_$S(FSSIG:$G(VASARY(FSSIG)),1:"")
- . S SLOOP=1 F S SLOOP=$O(VASARY(SLOOP)) Q:'SLOOP D
- . . S LINE=LINE+1 S @TMPGBL@(LINE,0)=" "_VASARY(SLOOP)
- . S VPATINST=$$GET1^DIQ(52.49,ERXIEN,27,"E")
- . I VPATINST]"" S VPATINST=$$LSIG^PSOQUTIL(VPATINST)
- . D TXT2ARY^PSOERXD1(.VAPIARY,VPATINST," ",68)
- . S FSVPIN=$O(VAPIARY(0))
- . S LINE=LINE+1 S @TMPGBL@(LINE,0)=" Pat Inst: "_$S(FSVPIN:$G(VAPIARY(FSVPIN)),1:"")
- . S VLOOP=1 F S VLOOP=$O(VAPIARY(VLOOP)) Q:'VLOOP D
- . . S LINE=LINE+1 S @TMPGBL@(LINE,0)=" "_VAPIARY(VLOOP)
- S LINE=LINE+1 S @TMPGBL@(LINE,0)="Hold Status: "_$G(VAHSTA)
- S VAHREA="Hold Reason: "_$G(VAHREA)
- D TXT2ARY^PSOERXD1(.HARY,VAHREA," ",80)
- S HL=0 F S HL=$O(HARY(HL)) Q:'HL D
- . S LINE=LINE+1 S @TMPGBL@(LINE,0)=$G(HARY(HL))
- S LINE=LINE+1 S @TMPGBL@(LINE,0)="Placed on hold by: "_$G(VAHPER)
- S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
- S ERXCOMM="eRx Notes: "_$$GET1^DIQ(52.49,ERXIEN,8,"E")
- D TXT2ARY^PSOERXD1(.COMARY,ERXCOMM," ",68)
- S COM=0 F S COM=$O(COMARY(COM)) Q:'COM S LINE=LINE+1 S @TMPGBL@(LINE,0)=$G(COMARY(COM))
- I ",CR,"[(","_MTYPE_",") D ADDPNOTE^PSOERX1H(.LINE,$G(PNCOMM))
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERSE4 12620 printed Jan 18, 2025@03:29:07 Page 2
- PSOERSE4 ;ALB/RM - PSO ERX UTILITY ROUTINE ;Jan 23, 2023@12:43:34
- +1 ;;7.0;OUTPATIENT PHARMACY;**746**;DEC 16, 1997;Build 106
- +2 ;
- +3 ;
- +4 ;No Direct Call
- QUIT
- +5 ;
- BUILDLST(TMPGBL,ERXIEN,PNCOMM) ;
- +1 ;Input : TMPGBL - The temporary global location to store the eRx data
- +2 ; Example: ^TMP("TIUP",$J)
- +3 ; ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
- +4 ; PNCOMM - Patient Progress Note Comment.
- +5 ; Example. This is a sample eRx patient Progress Note.
- +6 ;Output: Create/Build the eRx temporary global
- +7 if '$GET(ERXIEN)
- QUIT
- +8 NEW PATIEN,PHARMIEN,PRVIEN,PHDAT,PATDAT,SUPDAT,PRVDAT,LINE,PRVLNM,PRVMI,PRVFN,EPAT,EPATDOB,VPATIEN,HARY,HL,PROHIBIT,ERXWRDT
- +9 NEW VPATNM,VPATDOB,EPRVIEN,EPRVNM,EPRVNPI,EPRVDEA,VAPRVIEN,VAPRVNM,VAPRVNPI,VAPRVDEA,SUPIEN,ERXDRUG,ERXQTY,ERXFLS,CSCOMM,MEDIEN
- +10 NEW ERXDS,ERXDT,VADRGIEN,VADRG,LINETXT,ERXCOMM,ERXRFLS,PATIENS,VAHREA,VAQTY,VAREF,VASIG,PATDAT,CURSTATE,CURSTATI,WDATE,RRNRXIEN
- +11 NEW LHFOUND,LHMATCH,LHSTATI,VAPDEAEX,ERXCOMM,COMFRST,COMARY,SIGDATA,SIGLOOP,SFIRSPROT,SGLOOP,SIGARY,VADAYS,NRXIEN,ERXPNC,ERXPNARY,PNLOOP
- +12 NEW SLOOP,VASIG,VASARY,FSSIG,VAHSTA,EDIRECT,VAHPER,PAMANVAL,DRMANVAL,PRMANVAL,VPATINST,VAPIARY,VLOOP,FSVPIN,S2017,NEWRXIEN
- +13 NEW DRGARY,DLP,MTYPE,MTYPEE,ERXSTAT,STATIEN,PDIAGTXT,SDIAGTXT,RELIEN,RELMTYPE,ERRIEN,LERXSTAT,LOPSTAT,OPIEN,ERXDSUB,COM,EXSTATUS,R2017,REQIEN
- +14 NEW SFIRST,PATPT,EPRVPT,CIEN,CHGMESRI,CHGMESRQ,NO311,RESPVAL,ERRFLG,PSNF,ERXPNAME,ERXRFNUM,LINE,HTWT,DDASH
- +15 ;
- +16 ;This variable needs to be new'ed in the calling routine
- KILL @TMPGBL
- +17 ;LINE here serves as the counter
- SET LINE=0
- +18 SET ERXPNAME=$$GET1^DIQ(52.49,ERXIEN,.04,"E")
- +19 SET ERXRFNUM=$$GET1^DIQ(52.49,ERXIEN,.01,"E")
- +20 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)="eRx Patient: "_ERXPNAME
- +21 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)="eRx Reference #: "_ERXRFNUM
- +22 SET HTWT=$$BHW^PSOERXIU(ERXIEN)
- +23 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)=HTWT
- +24 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)=""
- +25 ; set the standard field
- +26 SET S2017=$$GET1^DIQ(52.49,ERXIEN,312.1,"I")
- +27 SET MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
- +28 SET MTYPEE=$$GET1^DIQ(52.49,ERXIEN,.08,"E")
- +29 SET STATIEN=$$GET1^DIQ(52.49,ERXIEN,1,"I")
- +30 SET ERXSTAT=$$GET1^DIQ(52.49,ERXIEN,1)_" - "_$$GET1^DIQ(52.45,$$GET1^DIQ(52.49,ERXIEN,1,"I"),.02)
- +31 IF MTYPE'="IE"
- SET ERRFLG=0
- +32 SET PATIEN=$$GET1^DIQ(52.49,ERXIEN,.04,"I")
- IF 'PATIEN
- SET PATIEN=$$GETPAT^PSOERXU5(ERXIEN)
- +33 SET PATIENS=PATIEN_","
- +34 DO GETS^DIQ(52.46,PATIENS,"**","IE","PATDAT")
- +35 IF 'ERRFLG
- Begin DoDot:1
- +36 SET EPAT=$GET(PATDAT(52.46,PATIENS,.01,"E"))
- +37 SET EPATDOB=$GET(PATDAT(52.46,PATIENS,.08,"I"))
- SET EPATDOB=$$FMTE^XLFDT(EPATDOB,"2D")
- End DoDot:1
- +38 IF ERRFLG
- Begin DoDot:1
- +39 SET (EPAT,EPATDOB)=""
- End DoDot:1
- +40 SET VPATIEN=$$GET1^DIQ(52.49,ERXIEN,.05,"I")
- +41 SET VPATNM=$SELECT(VPATIEN&'ERRFLG:$$GET1^DIQ(2,VPATIEN,.01,"E"),1:"NOT LINKED")
- +42 SET VPATDOB=$SELECT(VPATIEN&'ERRFLG:$$GET1^DIQ(2,VPATIEN,.03,"I"),1:"N/A")
- +43 IF VPATDOB
- SET VPATDOB=$$FMTE^XLFDT(VPATDOB,"2D")
- +44 SET PHARMIEN=$$GET1^DIQ(52.49,ERXIEN,2.5,"I")
- +45 DO GETS^DIQ(52.47,PHARMIEN,"**","E","PHDAT")
- +46 SET EPRVIEN=$$GET1^DIQ(52.49,ERXIEN,2.1,"I")
- IF 'EPRVIEN
- SET EPRVIEN=$$GETPROV^PSOERXU5(ERXIEN)
- +47 SET EPRVNM=$$GET1^DIQ(52.48,EPRVIEN,.01,"E")
- +48 ; erx provider primary phone 2017071
- +49 IF S2017
- Begin DoDot:1
- +50 SET EPRVPT=$$COMMVAL^PSOERXU5(EPRVIEN,52.48,11,"PT",1)
- End DoDot:1
- +51 IF 'S2017
- Begin DoDot:1
- +52 NEW IENS,TYPE,EXT
- +53 SET EPRVPT=""
- SET CIEN=$ORDER(^PS(52.48,EPRVIEN,3,"C","TE",0))
- +54 IF CIEN
- Begin DoDot:2
- +55 SET IENS=CIEN_","_EPRVIEN_","
- +56 SET EPRVPT=$$GET1^DIQ(52.483,IENS,.01,"I")
- End DoDot:2
- +57 IF 'CIEN
- Begin DoDot:2
- +58 SET CIEN=0
- +59 FOR
- SET CIEN=$ORDER(^PS(52.48,EPRVIEN,3,CIEN))
- if CIEN'?1.N
- QUIT
- Begin DoDot:3
- +60 SET IENS=CIEN_","_EPRVIEN_","
- +61 SET EPRVPT=$$GET1^DIQ(52.483,IENS,.01,"I")
- +62 SET TYPE=$$GET1^DIQ(52.483,IENS,.02,"I")
- +63 if TYPE="EM"
- SET EPRVPT=""
- End DoDot:3
- if EPRVPT]""
- QUIT
- End DoDot:2
- +64 IF EPRVPT]""
- Begin DoDot:2
- +65 SET EXT=$$GET1^DIQ(52.483,IENS,.03,"I")
- +66 if EXT]""
- SET EPRVPT=EPRVPT_"X"_EXT
- End DoDot:2
- End DoDot:1
- +67 IF 'S2017
- SET EPRVNPI=$$GET1^DIQ(52.48,EPRVIEN,1.5,"E")
- +68 IF S2017
- SET EPRVNPI=$$GET1^DIQ(52.48,EPRVIEN,15.1,"E")
- +69 SET EPRVDEA=$$GET1^DIQ(52.48,EPRVIEN,1.6,"E")
- +70 SET VAPRVIEN=$$GET1^DIQ(52.49,ERXIEN,2.3,"I")
- +71 SET ERXWRDT=$$GET1^DIQ(52.49,ERXIEN,5.9,"I")
- +72 SET VAPRVNM=$SELECT(VAPRVIEN:$$GET1^DIQ(200,VAPRVIEN,.01,"E"),1:"NOT LINKED")
- +73 SET VAPRVNPI=$SELECT(VAPRVIEN:$$GET1^DIQ(200,VAPRVIEN,41.99,"E"),1:"N/A")
- +74 SET VAPRVDEA=$SELECT(VAPRVIEN:$$DEA^XUSER(0,VAPRVIEN,ERXWRDT),1:"N/A")
- +75 DO GETS^DIQ(52.48,EPRVIEN,"**","E","PRVDAT")
- +76 SET SUPIEN=$$GET1^DIQ(52.49,ERXIEN,2.6,"I")
- +77 DO GETS^DIQ(52.48,SUPIEN,"**","E","SUPDAT")
- +78 SET PAMANVAL=$$GET1^DIQ(52.49,ERXIEN,1.7,"I")
- +79 SET PRMANVAL=$$GET1^DIQ(52.49,ERXIEN,1.3,"I")
- +80 SET DRMANVAL=$$GET1^DIQ(52.49,ERXIEN,1.5,"I")
- +81 SET WDATE=$$GET1^DIQ(52.49,ERXIEN,5.9,"E")
- +82 SET CHGMESRQ=$$GET1^DIQ(52.49,ERXIEN,315.1,"I")
- +83 SET CHGMESRI=$$GET1^DIQ(52.45,CHGMESRQ,.01,"I")
- +84 SET RESPVAL=$$GET1^DIQ(52.49,ERXIEN,52.1,"E")
- +85 if 'ERRFLG
- SET PATPT=$$GETPTPH^PSOERXU7(PATIEN,S2017,"PT,HP")
- +86 ; only set the hold reason if the eRx has a hold status
- +87 SET CURSTATE=$$GET1^DIQ(52.49,ERXIEN,1,"E")
- +88 SET (VAHSTA,VAHREA)=""
- +89 IF S2017
- IF MTYPE'="RE"
- Begin DoDot:1
- +90 SET MEDIEN=$ORDER(^PS(52.49,ERXIEN,311,"C","P",0))
- +91 SET EDIRECT=$$GET1^DIQ(52.49,MEDIEN_","_ERXIEN_",",8,"E")
- +92 ;retrieved provider notes/comments
- IF $GET(MEDIEN)
- SET ERXPNC=$$GET1^DIQ(52.49311,MEDIEN_","_ERXIEN_",",5)
- End DoDot:1
- +93 IF S2017
- IF MTYPE="RE"
- Begin DoDot:1
- +94 SET MEDIEN=$ORDER(^PS(52.49,ERXIEN,311,"C","MR",0))
- End DoDot:1
- +95 IF 'S2017
- Begin DoDot:1
- +96 SET EDIRECT=$$GET1^DIQ(52.49,ERXIEN,7,"E")
- End DoDot:1
- +97 IF $EXTRACT(CURSTATE,1)="H"
- Begin DoDot:1
- +98 SET CURSTATI=$$GET1^DIQ(52.49,ERXIEN,1,"I")
- +99 SET LHMATCH=999999
- SET LHFOUND=0
- FOR
- SET LHMATCH=$ORDER(^PS(52.49,ERXIEN,19,LHMATCH),-1)
- if 'LHMATCH!(LHFOUND)
- QUIT
- Begin DoDot:2
- +100 SET LHSTATI=$$GET1^DIQ(52.4919,LHMATCH_","_ERXIEN_",",.02,"I")
- IF LHSTATI=CURSTATI
- Begin DoDot:3
- +101 SET VAHREA=$$GET1^DIQ(52.4919,LHMATCH_","_ERXIEN_",",1)
- +102 SET VAHSTA=$$GET1^DIQ(52.45,LHSTATI,.01,"E")_" - "_$$GET1^DIQ(52.45,LHSTATI,.02,"E")
- +103 SET VAHPER=$$GET1^DIQ(52.4919,LHMATCH_","_ERXIEN_",",.03,"E")
- End DoDot:3
- SET LHFOUND=LHMATCH
- QUIT
- End DoDot:2
- End DoDot:1
- +104 IF (",RE,CN,"[(","_MTYPE_","))!((MTYPE="CX")&$$CHGMTYPE^PSOERX1D(ERXIEN,MTYPE,RESPVAL,CHGMESRI))
- SET MTYPEE=$GET(MTYPEE)_" - "_$$GET1^DIQ(52.49,ERXIEN,52.1,"E")
- +105 SET LINETXT=""
- +106 IF $$GET1^DIQ(52.49,ERXIEN,95.1,"I")
- SET $EXTRACT(MTYPEE,63)="EPCS DEA VALIDATED"
- +107 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)=MTYPEE
- +108 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)="eRx Status: "_$SELECT($EXTRACT(CURSTATE,1)="H":VAHSTA,1:ERXSTAT)
- +109 IF ",CX,CR,"[(","_MTYPE_",")
- IF $$QTSUMDT1^PSOERSE5(TMPGBL,ERXIEN,MTYPE,CHGMESRI,CHGMESRQ,RESPVAL,.LINE)
- Begin DoDot:1
- +110 IF ",CR,"[(","_MTYPE_",")
- DO ADDPNOTE^PSOERX1H(.LINE,$GET(PNCOMM))
- End DoDot:1
- QUIT
- +111 ;
- +112 IF $GET(CSCOMM)]""
- SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)="Current Status Details: "_CSCOMM
- +113 IF $DATA(LERXSTAT)
- SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)="Last New Rx status: "_LERXSTAT
- +114 IF $DATA(LOPSTAT)
- SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)="Outpatient Prescription status: "_LOPSTAT
- +115 IF @TMPGBL@(LINE,0)'=""
- SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)=""
- +116 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)="**************************MEDICATION PRESCRIBED******************************"
- +117 IF 'ERRFLG
- IF $LENGTH($GET(PATPT))
- SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)="eRx Patient Primary Telephone: "_PATPT
- +118 SET LINE=LINE+1
- +119 DO ADDITEM^PSOERX1A(.LINETXT,"eRx Patient: ",EPAT,1,52)
- +120 DO ADDITEM^PSOERX1A(.LINETXT,"DOB: ",EPATDOB,57,20)
- +121 SET @TMPGBL@(LINE,0)=LINETXT
- SET LINETXT=""
- +122 SET LINE=LINE+1
- +123 IF $LENGTH($GET(EPRVPT))
- SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)="eRx Provider Primary Telephone: "_EPRVPT
- +124 SET LINE=LINE+1
- +125 DO ADDITEM^PSOERX1A(.LINETXT,"eRx Provider: ",EPRVNM,1,52)
- +126 SET @TMPGBL@(LINE,0)=LINETXT
- SET LINETXT=""
- +127 DO ADDITEM^PSOERX1A(.LINETXT,"DEA#: ",EPRVDEA,30,20)
- +128 DO ADDITEM^PSOERX1A(.LINETXT,"NPI: ",EPRVNPI,57,20)
- +129 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)=LINETXT
- SET LINETXT=""
- +130 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)=""
- +131 SET ERXDRUG=$$GET1^DIQ(52.49,ERXIEN,3.1,"E")
- IF '$LENGTH(ERXDRUG)
- SET ERXDRUG=$$GETDRUG^PSOERXU5(ERXIEN)
- +132 SET ERXQTY=$$GET1^DIQ(52.49,ERXIEN,5.1,"E")
- +133 IF $GET(S2017)
- SET ERXRFLS=$$GET1^DIQ(52.49,ERXIEN,5.6,"E")
- +134 ;If the message type is 'CX' for RXCHANGERESPONSE, display the Prescriber Drug Use Evaluation.
- +135 IF MTYPE="CX"
- DO DSPLYDUE^PSOERSE3(ERXIEN,.LINE,1,TMPGBL)
- +136 ;setting 10.6 refill value
- +137 IF '$GET(S2017)
- Begin DoDot:1
- +138 SET ERXRFLS=$$GET1^DIQ(52.49,ERXIEN,5.6,"E")
- +139 IF ERXRFLS=""
- SET ERXRFLS=$$GET1^DIQ(52.49,ERXIEN,5.7,"I")
- End DoDot:1
- +140 SET ERXDS=$$GET1^DIQ(52.49,ERXIEN,5.5,"E")
- +141 SET ERXDT=$$GET1^DIQ(52.49,ERXIEN,.03,"E")
- +142 IF S2017
- Begin DoDot:1
- +143 SET ERXDT=$SELECT(MEDIEN:$$EFFDATE^PSOERXU5(ERXIEN,MEDIEN),1:"")
- End DoDot:1
- +144 SET VADRGIEN=$$GET1^DIQ(52.49,ERXIEN,3.2,"I")
- +145 SET VADRG=$$GET1^DIQ(52.49,ERXIEN,3.2,"E")
- +146 SET VAREF=$$GET1^DIQ(52.49,ERXIEN,20.5,"E")
- +147 SET VAQTY=$$GET1^DIQ(52.49,ERXIEN,20.1,"E")
- +148 SET VADAYS=$$GET1^DIQ(52.49,ERXIEN,20.2,"E")
- +149 IF VADRG']""
- SET VADRG="NOT LINKED"
- +150 DO TXT2ARY^PSOERXD1(.DRGARY,ERXDRUG,,70)
- +151 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)="eRx Drug: "_$GET(DRGARY(1))_" "_$PIECE($$ERXDRSCH^PSOERXUT(ERXIEN),"^",2)
- +152 SET DLP=1
- +153 FOR
- SET DLP=$ORDER(DRGARY(DLP))
- if 'DLP
- QUIT
- Begin DoDot:1
- +154 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)=" "_$GET(DRGARY(DLP))
- End DoDot:1
- +155 SET LINE=LINE+1
- +156 DO ADDITEM^PSOERX1A(.LINETXT,"eRx Qty: ",ERXQTY,1,17)
- +157 DO ADDITEM^PSOERX1A(.LINETXT,"eRx Refills: ",ERXRFLS,19,16)
- +158 DO ADDITEM^PSOERX1A(.LINETXT,"eRx Days Supply: ",ERXDS,37,20)
- +159 IF 'S2017
- DO ADDITEM^PSOERX1A(.LINETXT,"eRx Date: ",$PIECE(ERXDT,"@"),58,22)
- +160 SET @TMPGBL@(LINE,0)=LINETXT
- SET LINETXT=""
- +161 IF S2017
- Begin DoDot:1
- +162 SET LINE=LINE+1
- +163 DO ADDITEM^PSOERX1A(.LINETXT,"eRx Written Date: ",$PIECE(WDATE,"@"),1,35)
- +164 DO ADDITEM^PSOERX1A(.LINETXT,"eRx Issue Date: ",ERXDT,40,70)
- +165 SET @TMPGBL@(LINE,0)=LINETXT
- SET LINETXT=""
- +166 SET LINE=LINE+1
- +167 IF MTYPE="N"!((MTYPE="CX")&$$PROHIBIT^PSOERX1D(RESPVAL,CHGMESRI))
- Begin DoDot:2
- +168 SET PROHIBIT=$$GET1^DIQ(52.49,ERXIEN,301.3,"I")
- +169 SET PROHIBIT=$SELECT(PROHIBIT=1:"Yes",1:"No")
- +170 SET @TMPGBL@(LINE,0)="Prohibit Renewals: "_PROHIBIT
- End DoDot:2
- End DoDot:1
- +171 DO TXT2ARY^PSOERXD1(.SIGARY,$GET(EDIRECT),,70)
- +172 SET SFIRST=$ORDER(SIGARY(0))
- +173 IF 'S2017
- Begin DoDot:1
- +174 SET SGLOOP=0
- FOR
- SET SGLOOP=$ORDER(SIGARY(SGLOOP))
- if 'SGLOOP
- QUIT
- Begin DoDot:2
- +175 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)=$SELECT(SGLOOP=SFIRST:"eRx Sig: ",1:" ")_$GET(SIGARY(SGLOOP))
- End DoDot:2
- End DoDot:1
- +176 IF S2017
- IF $GET(MEDIEN)
- Begin DoDot:1
- +177 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)="eRx Sig: "
- +178 SET SGLOOP=0
- FOR
- SET SGLOOP=$ORDER(^PS(52.49,ERXIEN,311,MEDIEN,8,SGLOOP))
- if 'SGLOOP
- QUIT
- Begin DoDot:2
- +179 IF SGLOOP=1
- SET @TMPGBL@(LINE,0)=@TMPGBL@(LINE,0)_$GET(^PS(52.49,ERXIEN,311,MEDIEN,8,SGLOOP,0))
- QUIT
- +180 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)=$GET(^PS(52.49,ERXIEN,311,MEDIEN,8,SGLOOP,0))
- End DoDot:2
- +181 KILL ERXPNARY
- DO TXT2ARY^PSOERXD1(.ERXPNARY,$GET(ERXPNC),,80)
- +182 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)="eRx Provider Notes/Comments:"
- +183 IF $DATA(ERXPNARY)
- Begin DoDot:2
- +184 SET PNLOOP=0
- FOR
- SET PNLOOP=$ORDER(ERXPNARY(PNLOOP))
- if 'PNLOOP
- QUIT
- Begin DoDot:3
- +185 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)=$GET(ERXPNARY(PNLOOP))
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +186 IF (",CX,CR,"[(","_MTYPE_","))
- IF $$QTSUMDT2^PSOERSE5(TMPGBL,ERXIEN,MTYPE,CHGMESRI,RESPVAL,.LINE)
- Begin DoDot:1
- +187 IF ",CR,"[(","_MTYPE_",")
- DO ADDPNOTE^PSOERX1H(.LINE,$GET(PNCOMM))
- End DoDot:1
- QUIT
- +188 ;
- DISPRX ;
- +1 IF "RR,CA,CN,IE"'[MTYPE!(MTYPE="N")
- Begin DoDot:1
- +2 IF MTYPE="RE"
- IF $$GET1^DIQ(52.49,ERXIEN,52.1,"I")'="R"
- QUIT
- +3 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)=""
- +4 ;p689
- SET PSNF=""
- IF $GET(VADRGIEN)
- SET PSNF=$SELECT($PIECE(^PSDRUG(VADRGIEN,0),"^",9):"***(N/F)***",1:"")
- +5 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)="Vista Drug"_$SELECT(DRMANVAL:"[v]",1:"")_": "_VADRG_" "_$PIECE($$VADRSCH^PSOERXUT(VADRGIEN),"^",3)_PSNF
- +6 SET LINE=LINE+1
- +7 DO ADDITEM^PSOERX1A(.LINETXT,"Vista Qty: ",$GET(VAQTY),1,25)
- +8 DO ADDITEM^PSOERX1A(.LINETXT,"Vista Refills: ",$GET(VAREF),27,18)
- +9 DO ADDITEM^PSOERX1A(.LINETXT,"Vista Days Supply: ",$GET(VADAYS),54,22)
- +10 SET @TMPGBL@(LINE,0)=LINETXT
- SET LINETXT=""
- +11 SET VASIG=""
- +12 SET SLOOP=0
- FOR
- SET SLOOP=$ORDER(^PS(52.49,ERXIEN,"SIG",SLOOP))
- if 'SLOOP
- QUIT
- Begin DoDot:2
- +13 IF '$LENGTH($GET(VASIG))
- SET VASIG=$GET(^PS(52.49,ERXIEN,"SIG",SLOOP,0))
- QUIT
- +14 SET VASIG=$GET(VASIG)_" "_$GET(^PS(52.49,ERXIEN,"SIG",SLOOP,0))
- End DoDot:2
- +15 DO TXT2ARY^PSOERXD1(.VASARY,VASIG,,68)
- +16 SET FSSIG=$ORDER(VASARY(0))
- +17 SET ERXDSUB=$$GET1^DIQ(52.49,ERXIEN,5.8,"I")
- +18 SET ERXDSUB=$SELECT(ERXDSUB=1:"NO",ERXDSUB=0:"YES",1:"")
- +19 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)="Substitutions? :"_ERXDSUB
- +20 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)="Vista Sig: "_$SELECT(FSSIG:$GET(VASARY(FSSIG)),1:"")
- +21 SET SLOOP=1
- FOR
- SET SLOOP=$ORDER(VASARY(SLOOP))
- if 'SLOOP
- QUIT
- Begin DoDot:2
- +22 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)=" "_VASARY(SLOOP)
- End DoDot:2
- +23 SET VPATINST=$$GET1^DIQ(52.49,ERXIEN,27,"E")
- +24 IF VPATINST]""
- SET VPATINST=$$LSIG^PSOQUTIL(VPATINST)
- +25 DO TXT2ARY^PSOERXD1(.VAPIARY,VPATINST," ",68)
- +26 SET FSVPIN=$ORDER(VAPIARY(0))
- +27 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)=" Pat Inst: "_$SELECT(FSVPIN:$GET(VAPIARY(FSVPIN)),1:"")
- +28 SET VLOOP=1
- FOR
- SET VLOOP=$ORDER(VAPIARY(VLOOP))
- if 'VLOOP
- QUIT
- Begin DoDot:2
- +29 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)=" "_VAPIARY(VLOOP)
- End DoDot:2
- End DoDot:1
- +30 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)="Hold Status: "_$GET(VAHSTA)
- +31 SET VAHREA="Hold Reason: "_$GET(VAHREA)
- +32 DO TXT2ARY^PSOERXD1(.HARY,VAHREA," ",80)
- +33 SET HL=0
- FOR
- SET HL=$ORDER(HARY(HL))
- if 'HL
- QUIT
- Begin DoDot:1
- +34 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)=$GET(HARY(HL))
- End DoDot:1
- +35 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)="Placed on hold by: "_$GET(VAHPER)
- +36 SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)=""
- +37 SET ERXCOMM="eRx Notes: "_$$GET1^DIQ(52.49,ERXIEN,8,"E")
- +38 DO TXT2ARY^PSOERXD1(.COMARY,ERXCOMM," ",68)
- +39 SET COM=0
- FOR
- SET COM=$ORDER(COMARY(COM))
- if 'COM
- QUIT
- SET LINE=LINE+1
- SET @TMPGBL@(LINE,0)=$GET(COMARY(COM))
- +40 IF ",CR,"[(","_MTYPE_",")
- DO ADDPNOTE^PSOERX1H(.LINE,$GET(PNCOMM))
- +41 QUIT