- PSOERSE1 ;ALB/RM - Single eRx View/Display ;Jan 30, 2024@12:43:34
- ;;7.0;OUTPATIENT PHARMACY;**746,769**;DEC 16, 1997;Build 26
- ;
- ;
- Q ;No Direct Call
- ;
- EN(PSOIEN) ; -- main entry point for PSO ERX SINGLE ERX DISPLAY
- N ERXIEN,MBMSITE,ERXSTATSD,ERXMTYPE,SDERXFLG,HGHLIGHT
- Q:'$G(PSOIEN)
- S ERXIEN=PSOIEN
- S ERXSTATSD="" ;this variable is used to hold the eRx status
- S SDERXFLG=1
- S MBMSITE=$S($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
- D EN^VALM("PSO ERX SINGLE ERX DISPLAY")
- Q
- ;
- HDR ; -- header code
- N HDR K VALMHDR
- S VALMHDR(1)="eRx Patient: "_IOINHI_$E($$GET1^DIQ(52.49,ERXIEN,.04,"E"),1,30)_IOINORM
- D INSTR^VALM1("eRx Reference #: "_IOINHI_$$GET1^DIQ(52.49,ERXIEN,.01)_IOINORM,50,2)
- S VALMHDR(2)="eRx Msg Type: "_IOINHI_$$GETMTYPE(ERXIEN)_IOINORM
- I $$GET1^DIQ(52.49,ERXIEN,10.5,"I")=2 D
- . D INSTR^VALM1(IORVON_"ERX HAS DO NOT FILL INDICATOR PER PROVIDER"_IORVOFF,39,3)
- E I $$GET1^DIQ(52.49,ERXIEN,95.1,"I") D
- . D INSTR^VALM1(IORVON_"EPCS DEA VALIDATED"_IORVOFF,63,3) ;controlled substance indicator
- E D INSTR^VALM1("Written: "_IOINHI_$$FMTE^XLFDT($$GET1^DIQ(52.49,ERXIEN,5.9,"I")\1,"2Z"),64,3)
- S VALMHDR(3)=IORVOFF_"eRx Status: "_IOINHI_$$GET1^DIQ(52.49,ERXIEN,1)_" - "_$$GET1^DIQ(52.45,$$GET1^DIQ(52.49,ERXIEN,1,"I"),.02)
- S VALMHDR(3)=VALMHDR(3)_$S($$GET1^DIQ(52.49,ERXIEN,1)="HFF":" ("_$$GET1^DIQ(52.49,ERXIEN,6.7)_")",1:"")_IOINORM
- I ",RR,RE,IE,OE,CA,CN,CX,CR,"'[(","_$$GET1^DIQ(52.49,ERXIEN,.08,"I")_",") D
- . S HDR="",$E(HDR,20)="ERX",$E(HDR,40)="|",$E(HDR,58)="VISTA"
- S $E(HDR,81)="" D INSTR^VALM1(IORVON_IOUON_HDR_IORVOFF_IOINORM,1,5)
- Q
- ;
- GETMTYPE(ERXIEN) ;Retrieve the eRx Message Type
- ; Input : ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
- ; Output: MTYPEE - eRx Message Type
- N MTYPE,MTYPEE,RESPVAL,CHGMESRQ,CHGMESRI
- S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
- S MTYPEE=$$GET1^DIQ(52.49,ERXIEN,.08,"E")
- S RESPVAL=$$GET1^DIQ(52.49,ERXIEN,52.1,"E")
- S CHGMESRQ=$$GET1^DIQ(52.49,ERXIEN,315.1,"I")
- S CHGMESRI=$$GET1^DIQ(52.45,CHGMESRQ,.01,"I")
- I (",RE,CN,"[(","_MTYPE_","))!((MTYPE="CX")&$$CHGMTYPE^PSOERX1D(ERXIEN,MTYPE,RESPVAL,CHGMESRI)) S MTYPEE=$G(MTYPEE)_"-"_$$GET1^DIQ(52.49,ERXIEN,52.1,"E")
- ;I $$GET1^DIQ(52.49,ERXIEN,95.1,"I") S $E(MTYPEE,63)="EPCS DEA VALIDATED" ;controlled substance indicator - commenting this because this will be overwritten with the Written date
- Q $G(MTYPEE)
- ;
- INIT ;
- N DDASH,MODE,NMSPC,ERXDATA,EPRVIEN,ERXDRGID,S2017,ERXRDT,XE,ERXHLDARY,ERXHLD,ERXHLDRSN
- ;determine the message type of this transaction to decide whether to display the side-by-side format or retain it as is.
- S ERXMTYPE=$P($$ERXMTYPE(ERXIEN),"^")
- S NMSPC="PSOERSE1",MODE="LM"
- K ^TMP("PSOERSE1",$J)
- S LINE=0
- D RESET^PSOERUT0() ; - Resetting list to NORMAL video attributes
- S ^TMP("PSOERSE1",$J,1,0)=""
- S VALMBG=1
- ;
- ;display and set the hold reason if the eRx has a hold status and if it contains data, otherwise, do not display
- S ERXHLD=$$GETHLDSTA(.ERXHLDARY,ERXIEN)
- I +$G(ERXHLD)>1,$G(ERXHLDARY($J,3))'="" D
- . S ERXHLDRSN=$G(ERXHLDARY($J,3))
- . I $L(ERXHLDARY($J,3))>62 S ERXHLDRSN=$E(ERXHLDARY($J,3),1,60)_"..." ;truncate if it is longer than 60
- . S LINE=LINE+1 D ADDLINE^PSOERUT0(MODE,NMSPC,"eRx Hold Reason: "_ERXHLDRSN) ;this API automatically add a line, so no need to increment the line number
- . D CNTRL^VALM10(LINE-1,18,$L(ERXHLDRSN),IOINHI,IOINORM)
- ;
- I ",RR,RE,IE,OE,CA,CN,CX,CR,"[(","_ERXMTYPE_",") D Q ;if the message type contain one these types, the display will remain as is (NOT side by side format)
- . S SDERXFLG=0 D INIT^PSOERSE2(ERXIEN,SDERXFLG)
- . I $D(@VALMAR) D
- . . I $D(@VALMAR@(LINE)) S LINE=LINE+1
- . . S $P(DDASH,"_",81)="" D SET^VALM10(LINE,DDASH)
- . . S LINE=LINE+1 D ERXRCVDT(ERXIEN)
- . . I '$D(@VALMAR@(LINE)) S LINE=LINE-1 D CNTRL^VALM10(LINE,1,80,IOINHI,IOINORM)
- . . S VALMCNT=LINE
- ;
- ;side by side format begins here
- D SETPAT^PSOERUT0(MODE,ERXIEN,,NMSPC,0,1) ;Display Patient data
- S EPRVIEN=$$GET1^DIQ(52.49,ERXIEN,2.1,"I")
- I 'EPRVIEN S EPRVIEN=$$GETPROV^PSOERXU5(ERXIEN)
- D SETPROV^PSOERUT1(MODE,ERXIEN,,NMSPC,0,1) ;Display Provider data
- ;
- D ERXDATA^PSOERXU9(.ERXDATA,ERXIEN)
- S ERXDRGID=""
- I $D(ERXDATA) S ERXDRGID=$P(ERXDATA(1),"^",4)
- D SETDRUG^PSOERUT2(MODE,NMSPC,ERXIEN,0,0,1) ;Display Drug Data
- ;
- S S2017=$$GET1^DIQ(52.49,PSOIEN,312.1,"I") ;display erx written and issue/effective date
- D S2017(MODE,NMSPC,ERXIEN,S2017)
- D ALLERGY^PSOERUT3(MODE,NMSPC,ERXIEN,+$$GET1^DIQ(52.49,ERXIEN,.05,"I"))
- D SETDIAGS^PSOERUT3(MODE,NMSPC,ERXIEN)
- ;
- D ERXRCVDT(ERXIEN) ;display the eRx Received Date time stamp
- ; DEA Note for CS Digitally Signed eRx records
- I $$GET1^DIQ(52.49,PSOIEN,95.1,"I") S LINE=LINE-1 D DEANOTE(.LINE)
- S VALMCNT=LINE-1
- D VIDEO^PSOERUT0() ; Changes the Video Attributes for the list
- ;
- HELP ; -- help code
- ;S X="?" D DISP^XQORM1 W !!
- Q
- ;
- EXIT ; -- exit code
- K ERXSTATSD
- D CLEAN^VALM10
- D CLEAR^VALM1
- S VALMBCK="R",PSOREFSH=1
- Q
- ;
- EXPND ; -- expand code
- Q
- ;
- ERXMTYPE(ERXIEN) ;Retrieve the message type in File 52.49
- ; Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
- ;Output: Message Type Internal Value^Message Type External Value
- I +$G(ERXIEN)<1 Q ""
- N ERXMTYPE,ERTYPEX,STATIEN,ERXSTAT
- S ERXMTYPE=""
- S ERXMTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
- S ERTYPEX=$$GET1^DIQ(52.49,ERXIEN,.08,"E")
- S STATIEN=$$GET1^DIQ(52.49,ERXIEN,1,"I")
- S ERXSTAT=$$GET1^DIQ(52.45,STATIEN,.02,"E")
- Q $G(ERXMTYPE)_"^"_$G(ERTYPEX)
- ;
- ERXRCVDT(ERXIEN) ;
- N ERXRDT
- S ERXRDT=$$GETERXRDT(ERXIEN) ;display the eRx Received Date time stamp
- I $G(ERXRDT)'="" D
- . S XE=" eRx Received on "_$P(ERXRDT,"^")
- . I $P(ERXRDT,"^",2)'="" S XE=XE_" - Accepted by "_$P(ERXRDT,"^",2)_" on "_$P(ERXRDT,"^",3)
- . E S XE=" "_XE
- . D ADDLINE^PSOERUT0(MODE,NMSPC,$$COMPARE^PSOERUT0("LM",XE,XE,2))
- Q
- ;
- S2017(MODE,NAMESPACE,ERXIEN,S2017) ;Retrieve erx written and effective/issue date
- N ERXWDATE,ERXEFFDT,WDATE,ERXDT,XE,XV,MIEN,X
- I 'S2017 D
- . S WDATE=$$GET1^DIQ(52.49,ERXIEN,5.9,"I")\1
- . S ERXDT=$$GET1^DIQ(52.49,ERXIEN,.03,"I")
- . S XE="Written: "_$$COMPARE^PSOERUT0(MODE,$$FMTE^XLFDT(WDATE,"2Z"),$$FMTE^XLFDT(WDATE,"2Z"),10)
- . S XE=XE_" Effective: "_$$COMPARE^PSOERUT0(MODE,$$FMTE^XLFDT($P(ERXDT,"."),"2Z"),$$FMTE^XLFDT($P(ERXDT,"."),"2Z"),31)
- . D ADDLINE^PSOERUT0(MODE,NMSPC,XE,"|")
- I S2017 D
- . S MIEN=$O(^PS(52.49,ERXIEN,311,0))
- . S ERXEFFDT="",X=$$EFFDATE^PSOERXU5(ERXIEN,MIEN) I X'="" D ^%DT S ERXEFFDT=Y
- . S ERXWDATE=$$GET1^DIQ(52.49,ERXIEN,5.9,"I")\1
- . S XE="Written: "_$$COMPARE^PSOERUT0(MODE,$$FMTE^XLFDT($P(ERXWDATE,"."),"2Z"),$$FMTE^XLFDT($P(ERXWDATE,"."),"2Z"),10)
- . S XE=XE_" Effective: "_$$COMPARE^PSOERUT0(MODE,$$FMTE^XLFDT(ERXEFFDT,"2Z"),$$FMTE^XLFDT(ERXEFFDT,"2Z"),31)
- . D ADDLINE^PSOERUT0(MODE,NMSPC,XE,"|")
- Q
- ;
- GETHLDSTA(ERXHLDARY,ERXIEN) ;Retrieve the Erx Hold Status, Reason, and Hold By
- ; Input : ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
- ; Output: ERXHLDARY - An array which must be passed in by reference; returned with the following:
- ; ERXHLDARY(#)=value or if no hold status ERXHLDARY(0)=""
- ; Where:
- ; # - is a sequential number greater than zero
- ; value - is a line of text
- ; 1-Hold Status
- ; 2-Hold Reason
- ; 3-Hold Entered By
- N CURSTATE,CURSTATI,CNTR,HARY,HL,LHMATCH,LHFOUND,LHSTATI
- K ERXHLDARY
- ; only set the hold reason if the eRx has a hold status and hold reason contains data
- S CURSTATE=$$GET1^DIQ(52.49,ERXIEN,1,"E")
- S (VAHSTA,VAHREA,VAHPER)=""
- S CNTR=0
- 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 VAHSTA=$$GET1^DIQ(52.45,LHSTATI,.01,"E")_" - "_$$GET1^DIQ(52.45,LHSTATI,.02,"E"),CNTR=CNTR+1,ERXHLDARY($J,CNTR)=VAHSTA
- . . . S VAHPER=$$GET1^DIQ(52.4919,LHMATCH_","_ERXIEN_",",.03,"E"),CNTR=CNTR+1,ERXHLDARY($J,CNTR)=VAHPER
- . . . S VAHREA=$$GET1^DIQ(52.4919,LHMATCH_","_ERXIEN_",",1),CNTR=CNTR+1,ERXHLDARY($J,CNTR)=VAHREA
- I CNTR<1 S ERXHLDARY($J,0)=""
- Q $G(CNTR)
- ;
- GETERXRDT(ERXIEN) ;Retrieve the eRx Received Date time stamp
- ; Input : ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
- ; Output: ERXRADT - eRx Recieved Date time stamp^accepted by^date accepted
- ; Example: 1/19/24@14:05^LASTNAME,FIRSTNAME^9/26/24@10:30
- N ACCDTBY,ERXRADT
- Q:'$G(ERXIEN)
- S ACCDTBY=$$ACCDTBY^PSOERUT4(ERXIEN)
- S ERXRADT=$P($$FMTE^XLFDT($$GET1^DIQ(52.49,ERXIEN,.03,"I"),"2Y"),":",1,2)
- S ERXRADT=ERXRADT_"^"_$E($P(ACCDTBY,"^",2),1,17)_"^"_$P($P(ACCDTBY,"^",1),":",1,2)
- Q $G(ERXRADT)
- ;
- REF ;Screen Refresh
- I $D(VALMEVL) F I=1:1:99 D RESTORE^VALM10(I)
- D HDR,INIT S VALMBCK="R"
- Q
- ;
- VO ; View Original eRx Action
- N ORERXIEN,ERX
- S ORERXIEN=$$RELERX(ERXIEN,"N")
- I ORERXIEN S (ERXIEN,PSOIEN)=ORERXIEN
- E I ORERXIEN=0 S VALMSG="No Original eRx Found" S VALMBCK="R" W $C(7) Q
- D REF
- Q
- ;
- VRR ; View Request
- N RRERXIEN,ERX
- S RRERXIEN=$$RELERX(ERXIEN,"RR,CR,CA")
- I RRERXIEN S (ERXIEN,PSOIEN)=RRERXIEN
- E I RRERXIEN=0 S VALMSG="No Request eRx Found" S VALMBCK="R" W $C(7) Q
- D REF
- Q
- ;
- VRE ; View Request Response
- N REERXIEN,ERX
- S REERXIEN=$$RELERX(ERXIEN,"RE,CN,CX")
- I REERXIEN S (ERXIEN,PSOIEN)=REERXIEN
- E I REERXIEN=0 S VALMSG="No Response eRx Found" S VALMBCK="R" W $C(7) Q
- D REF
- Q
- ;
- RELERX(ERXIEN,MSGTYPE) ; Returns the Selected Related eRx IEN
- ; Input: ERXIEN - Pointer to ERX HOLDING QUEUE (#52.49)
- ; MSGTYPE - Relation types ("N":NewRx;"RR,CR,CA":Request;"RE,CN,CX":Response)
- ;Output: RELERX - Selected Related eRx (Original, Response, Request) - Pointer to #52.49 (0 if not found)
- N ERX,ERXARR,TMPARR,X,Y,DTOUT,DIROUT,SEQ,DIR,XX,RERX,REQIEN,RESIEN,ORIGIEN,MTYPE
- S (SEQ,ERX)=0
- F S ERX=$O(^PS(52.49,ERXIEN,201,"B",ERX)) Q:'ERX D
- . I '$D(TMPARR(ERX)),","_MSGTYPE_","[(","_$$GET1^DIQ(52.49,ERX,.08,"I")_",") D
- . . S SEQ=SEQ+1,ERXARR(SEQ)=ERX,TMPARR(ERX)=""
- . E S RERX=0 F S RERX=$O(^PS(52.49,ERX,201,"B",RERX)) Q:'RERX D
- . . I '$D(TMPARR(RERX)),","_MSGTYPE_","[(","_$$GET1^DIQ(52.49,RERX,.08,"I")_",") D
- . . . S SEQ=SEQ+1,ERXARR(SEQ)=RERX,TMPARR(RERX)=""
- ;
- I '$D(ERXARR) D
- . S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
- . S (ORIGIEN,REQIEN,RESIEN)=0
- . I ",RR,CA,CR,"[(","_MTYPE_",") D
- . . S REQIEN=ERXIEN,RESIEN=$$GETRESP^PSOERXU2(ERXIEN)
- . I ",RE,CN,CX,"[(","_MTYPE_",") D
- . . S RESIEN=ERXIEN,REQIEN=$$RESOLV^PSOERXU2(ERXIEN)
- . I MTYPE="IE" D
- . . S RESIEN=ERXIEN,REQIEN=$$RESOLV^PSOERXU2(ERXIEN)
- . I $G(REQIEN) D
- . . S ORIGIEN=+$O(^PS(52.49,"B",+$$GET1^DIQ(52.49,REQIEN,.14),0))
- . I MSGTYPE="N",$G(ORIGIEN),ORIGIEN'=ERXIEN S SEQ=SEQ+1,ERXARR(SEQ)=ORIGIEN
- . I MSGTYPE="RR,CR,CA",$G(REQIEN) S SEQ=SEQ+1,ERXARR(SEQ)=REQIEN
- . I MSGTYPE="RE,CN,CX",$G(RESIEN) S SEQ=SEQ+1,ERXARR(SEQ)=RESIEN
- ;
- I '$D(ERXARR) Q 0
- I '$D(ERXARR(2)) Q $G(ERXARR(1))
- D FULL^VALM1
- W !!,"# ERX ID",?22,"ERX TYPE",?42,"STATUS",?50,"DATE/TIME"
- S XX="",$P(XX,"-",72)="" W !,XX
- S SEQ=0 F S SEQ=$O(ERXARR(SEQ)) Q:'SEQ D
- . S ERX=ERXARR(SEQ) W !,SEQ,?3,$$GET1^DIQ(52.49,ERX,.01),?22,$$GET1^DIQ(52.49,ERX,.08),?42,$$GET1^DIQ(52.49,ERX,1),?50,$$GET1^DIQ(52.49,ERX,.03)
- W ! S DIR(0)="L^1:"_$O(ERXARR(999),-1),DIR("A")="SELECT"
- D ^DIR I $D(DIRUT)!$D(DIROUT) Q "^"
- Q ERXARR(+Y)
- Q
- ;
- DEANOTE(LINE) ;DEA Note for CS Digitally Signed eRx records
- N LINETXT
- S LINE=LINE+1 D SET^VALM10(LINE,"")
- S LINE=LINE+1,LINETXT=" This prescription meets the requirements of the Drug Enforcement Administration"
- D SET^VALM10(LINE,LINETXT),CNTRL^VALM10(LINE,1,$L(LINETXT)+1,IOINHI,IOINORM)
- S LINE=LINE+1,LINETXT=" (DEA) electronic prescribing for controlled substances rules (21 CFR Parts 1300,"
- D SET^VALM10(LINE,LINETXT),CNTRL^VALM10(LINE,1,$L(LINETXT)+1,IOINHI,IOINORM)
- S LINE=LINE+1,LINETXT=" 1304, 1306, & 1311)."
- D SET^VALM10(LINE,LINETXT),CNTRL^VALM10(LINE,2,$L(LINETXT),IOINHI,IOINORM)
- S LINE=LINE+1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERSE1 12234 printed Feb 18, 2025@23:54:22 Page 2
- PSOERSE1 ;ALB/RM - Single eRx View/Display ;Jan 30, 2024@12:43:34
- +1 ;;7.0;OUTPATIENT PHARMACY;**746,769**;DEC 16, 1997;Build 26
- +2 ;
- +3 ;
- +4 ;No Direct Call
- QUIT
- +5 ;
- EN(PSOIEN) ; -- main entry point for PSO ERX SINGLE ERX DISPLAY
- +1 NEW ERXIEN,MBMSITE,ERXSTATSD,ERXMTYPE,SDERXFLG,HGHLIGHT
- +2 if '$GET(PSOIEN)
- QUIT
- +3 SET ERXIEN=PSOIEN
- +4 ;this variable is used to hold the eRx status
- SET ERXSTATSD=""
- +5 SET SDERXFLG=1
- +6 SET MBMSITE=$SELECT($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
- +7 DO EN^VALM("PSO ERX SINGLE ERX DISPLAY")
- +8 QUIT
- +9 ;
- HDR ; -- header code
- +1 NEW HDR
- KILL VALMHDR
- +2 SET VALMHDR(1)="eRx Patient: "_IOINHI_$EXTRACT($$GET1^DIQ(52.49,ERXIEN,.04,"E"),1,30)_IOINORM
- +3 DO INSTR^VALM1("eRx Reference #: "_IOINHI_$$GET1^DIQ(52.49,ERXIEN,.01)_IOINORM,50,2)
- +4 SET VALMHDR(2)="eRx Msg Type: "_IOINHI_$$GETMTYPE(ERXIEN)_IOINORM
- +5 IF $$GET1^DIQ(52.49,ERXIEN,10.5,"I")=2
- Begin DoDot:1
- +6 DO INSTR^VALM1(IORVON_"ERX HAS DO NOT FILL INDICATOR PER PROVIDER"_IORVOFF,39,3)
- End DoDot:1
- +7 IF '$TEST
- IF $$GET1^DIQ(52.49,ERXIEN,95.1,"I")
- Begin DoDot:1
- +8 ;controlled substance indicator
- DO INSTR^VALM1(IORVON_"EPCS DEA VALIDATED"_IORVOFF,63,3)
- End DoDot:1
- +9 IF '$TEST
- DO INSTR^VALM1("Written: "_IOINHI_$$FMTE^XLFDT($$GET1^DIQ(52.49,ERXIEN,5.9,"I")\1,"2Z"),64,3)
- +10 SET VALMHDR(3)=IORVOFF_"eRx Status: "_IOINHI_$$GET1^DIQ(52.49,ERXIEN,1)_" - "_$$GET1^DIQ(52.45,$$GET1^DIQ(52.49,ERXIEN,1,"I"),.02)
- +11 SET VALMHDR(3)=VALMHDR(3)_$SELECT($$GET1^DIQ(52.49,ERXIEN,1)="HFF":" ("_$$GET1^DIQ(52.49,ERXIEN,6.7)_")",1:"")_IOINORM
- +12 IF ",RR,RE,IE,OE,CA,CN,CX,CR,"'[(","_$$GET1^DIQ(52.49,ERXIEN,.08,"I")_",")
- Begin DoDot:1
- +13 SET HDR=""
- SET $EXTRACT(HDR,20)="ERX"
- SET $EXTRACT(HDR,40)="|"
- SET $EXTRACT(HDR,58)="VISTA"
- End DoDot:1
- +14 SET $EXTRACT(HDR,81)=""
- DO INSTR^VALM1(IORVON_IOUON_HDR_IORVOFF_IOINORM,1,5)
- +15 QUIT
- +16 ;
- GETMTYPE(ERXIEN) ;Retrieve the eRx Message Type
- +1 ; Input : ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
- +2 ; Output: MTYPEE - eRx Message Type
- +3 NEW MTYPE,MTYPEE,RESPVAL,CHGMESRQ,CHGMESRI
- +4 SET MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
- +5 SET MTYPEE=$$GET1^DIQ(52.49,ERXIEN,.08,"E")
- +6 SET RESPVAL=$$GET1^DIQ(52.49,ERXIEN,52.1,"E")
- +7 SET CHGMESRQ=$$GET1^DIQ(52.49,ERXIEN,315.1,"I")
- +8 SET CHGMESRI=$$GET1^DIQ(52.45,CHGMESRQ,.01,"I")
- +9 IF (",RE,CN,"[(","_MTYPE_","))!((MTYPE="CX")&$$CHGMTYPE^PSOERX1D(ERXIEN,MTYPE,RESPVAL,CHGMESRI))
- SET MTYPEE=$GET(MTYPEE)_"-"_$$GET1^DIQ(52.49,ERXIEN,52.1,"E")
- +10 ;I $$GET1^DIQ(52.49,ERXIEN,95.1,"I") S $E(MTYPEE,63)="EPCS DEA VALIDATED" ;controlled substance indicator - commenting this because this will be overwritten with the Written date
- +11 QUIT $GET(MTYPEE)
- +12 ;
- INIT ;
- +1 NEW DDASH,MODE,NMSPC,ERXDATA,EPRVIEN,ERXDRGID,S2017,ERXRDT,XE,ERXHLDARY,ERXHLD,ERXHLDRSN
- +2 ;determine the message type of this transaction to decide whether to display the side-by-side format or retain it as is.
- +3 SET ERXMTYPE=$PIECE($$ERXMTYPE(ERXIEN),"^")
- +4 SET NMSPC="PSOERSE1"
- SET MODE="LM"
- +5 KILL ^TMP("PSOERSE1",$JOB)
- +6 SET LINE=0
- +7 ; - Resetting list to NORMAL video attributes
- DO RESET^PSOERUT0()
- +8 SET ^TMP("PSOERSE1",$JOB,1,0)=""
- +9 SET VALMBG=1
- +10 ;
- +11 ;display and set the hold reason if the eRx has a hold status and if it contains data, otherwise, do not display
- +12 SET ERXHLD=$$GETHLDSTA(.ERXHLDARY,ERXIEN)
- +13 IF +$GET(ERXHLD)>1
- IF $GET(ERXHLDARY($JOB,3))'=""
- Begin DoDot:1
- +14 SET ERXHLDRSN=$GET(ERXHLDARY($JOB,3))
- +15 ;truncate if it is longer than 60
- IF $LENGTH(ERXHLDARY($JOB,3))>62
- SET ERXHLDRSN=$EXTRACT(ERXHLDARY($JOB,3),1,60)_"..."
- +16 ;this API automatically add a line, so no need to increment the line number
- SET LINE=LINE+1
- DO ADDLINE^PSOERUT0(MODE,NMSPC,"eRx Hold Reason: "_ERXHLDRSN)
- +17 DO CNTRL^VALM10(LINE-1,18,$LENGTH(ERXHLDRSN),IOINHI,IOINORM)
- End DoDot:1
- +18 ;
- +19 ;if the message type contain one these types, the display will remain as is (NOT side by side format)
- IF ",RR,RE,IE,OE,CA,CN,CX,CR,"[(","_ERXMTYPE_",")
- Begin DoDot:1
- +20 SET SDERXFLG=0
- DO INIT^PSOERSE2(ERXIEN,SDERXFLG)
- +21 IF $DATA(@VALMAR)
- Begin DoDot:2
- +22 IF $DATA(@VALMAR@(LINE))
- SET LINE=LINE+1
- +23 SET $PIECE(DDASH,"_",81)=""
- DO SET^VALM10(LINE,DDASH)
- +24 SET LINE=LINE+1
- DO ERXRCVDT(ERXIEN)
- +25 IF '$DATA(@VALMAR@(LINE))
- SET LINE=LINE-1
- DO CNTRL^VALM10(LINE,1,80,IOINHI,IOINORM)
- +26 SET VALMCNT=LINE
- End DoDot:2
- End DoDot:1
- QUIT
- +27 ;
- +28 ;side by side format begins here
- +29 ;Display Patient data
- DO SETPAT^PSOERUT0(MODE,ERXIEN,,NMSPC,0,1)
- +30 SET EPRVIEN=$$GET1^DIQ(52.49,ERXIEN,2.1,"I")
- +31 IF 'EPRVIEN
- SET EPRVIEN=$$GETPROV^PSOERXU5(ERXIEN)
- +32 ;Display Provider data
- DO SETPROV^PSOERUT1(MODE,ERXIEN,,NMSPC,0,1)
- +33 ;
- +34 DO ERXDATA^PSOERXU9(.ERXDATA,ERXIEN)
- +35 SET ERXDRGID=""
- +36 IF $DATA(ERXDATA)
- SET ERXDRGID=$PIECE(ERXDATA(1),"^",4)
- +37 ;Display Drug Data
- DO SETDRUG^PSOERUT2(MODE,NMSPC,ERXIEN,0,0,1)
- +38 ;
- +39 ;display erx written and issue/effective date
- SET S2017=$$GET1^DIQ(52.49,PSOIEN,312.1,"I")
- +40 DO S2017(MODE,NMSPC,ERXIEN,S2017)
- +41 DO ALLERGY^PSOERUT3(MODE,NMSPC,ERXIEN,+$$GET1^DIQ(52.49,ERXIEN,.05,"I"))
- +42 DO SETDIAGS^PSOERUT3(MODE,NMSPC,ERXIEN)
- +43 ;
- +44 ;display the eRx Received Date time stamp
- DO ERXRCVDT(ERXIEN)
- +45 ; DEA Note for CS Digitally Signed eRx records
- +46 IF $$GET1^DIQ(52.49,PSOIEN,95.1,"I")
- SET LINE=LINE-1
- DO DEANOTE(.LINE)
- +47 SET VALMCNT=LINE-1
- +48 ; Changes the Video Attributes for the list
- DO VIDEO^PSOERUT0()
- +49 ;
- HELP ; -- help code
- +1 ;S X="?" D DISP^XQORM1 W !!
- +2 QUIT
- +3 ;
- EXIT ; -- exit code
- +1 KILL ERXSTATSD
- +2 DO CLEAN^VALM10
- +3 DO CLEAR^VALM1
- +4 SET VALMBCK="R"
- SET PSOREFSH=1
- +5 QUIT
- +6 ;
- EXPND ; -- expand code
- +1 QUIT
- +2 ;
- ERXMTYPE(ERXIEN) ;Retrieve the message type in File 52.49
- +1 ; Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
- +2 ;Output: Message Type Internal Value^Message Type External Value
- +3 IF +$GET(ERXIEN)<1
- QUIT ""
- +4 NEW ERXMTYPE,ERTYPEX,STATIEN,ERXSTAT
- +5 SET ERXMTYPE=""
- +6 SET ERXMTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
- +7 SET ERTYPEX=$$GET1^DIQ(52.49,ERXIEN,.08,"E")
- +8 SET STATIEN=$$GET1^DIQ(52.49,ERXIEN,1,"I")
- +9 SET ERXSTAT=$$GET1^DIQ(52.45,STATIEN,.02,"E")
- +10 QUIT $GET(ERXMTYPE)_"^"_$GET(ERTYPEX)
- +11 ;
- ERXRCVDT(ERXIEN) ;
- +1 NEW ERXRDT
- +2 ;display the eRx Received Date time stamp
- SET ERXRDT=$$GETERXRDT(ERXIEN)
- +3 IF $GET(ERXRDT)'=""
- Begin DoDot:1
- +4 SET XE=" eRx Received on "_$PIECE(ERXRDT,"^")
- +5 IF $PIECE(ERXRDT,"^",2)'=""
- SET XE=XE_" - Accepted by "_$PIECE(ERXRDT,"^",2)_" on "_$PIECE(ERXRDT,"^",3)
- +6 IF '$TEST
- SET XE=" "_XE
- +7 DO ADDLINE^PSOERUT0(MODE,NMSPC,$$COMPARE^PSOERUT0("LM",XE,XE,2))
- End DoDot:1
- +8 QUIT
- +9 ;
- S2017(MODE,NAMESPACE,ERXIEN,S2017) ;Retrieve erx written and effective/issue date
- +1 NEW ERXWDATE,ERXEFFDT,WDATE,ERXDT,XE,XV,MIEN,X
- +2 IF 'S2017
- Begin DoDot:1
- +3 SET WDATE=$$GET1^DIQ(52.49,ERXIEN,5.9,"I")\1
- +4 SET ERXDT=$$GET1^DIQ(52.49,ERXIEN,.03,"I")
- +5 SET XE="Written: "_$$COMPARE^PSOERUT0(MODE,$$FMTE^XLFDT(WDATE,"2Z"),$$FMTE^XLFDT(WDATE,"2Z"),10)
- +6 SET XE=XE_" Effective: "_$$COMPARE^PSOERUT0(MODE,$$FMTE^XLFDT($PIECE(ERXDT,"."),"2Z"),$$FMTE^XLFDT($PIECE(ERXDT,"."),"2Z"),31)
- +7 DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,"|")
- End DoDot:1
- +8 IF S2017
- Begin DoDot:1
- +9 SET MIEN=$ORDER(^PS(52.49,ERXIEN,311,0))
- +10 SET ERXEFFDT=""
- SET X=$$EFFDATE^PSOERXU5(ERXIEN,MIEN)
- IF X'=""
- DO ^%DT
- SET ERXEFFDT=Y
- +11 SET ERXWDATE=$$GET1^DIQ(52.49,ERXIEN,5.9,"I")\1
- +12 SET XE="Written: "_$$COMPARE^PSOERUT0(MODE,$$FMTE^XLFDT($PIECE(ERXWDATE,"."),"2Z"),$$FMTE^XLFDT($PIECE(ERXWDATE,"."),"2Z"),10)
- +13 SET XE=XE_" Effective: "_$$COMPARE^PSOERUT0(MODE,$$FMTE^XLFDT(ERXEFFDT,"2Z"),$$FMTE^XLFDT(ERXEFFDT,"2Z"),31)
- +14 DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,"|")
- End DoDot:1
- +15 QUIT
- +16 ;
- GETHLDSTA(ERXHLDARY,ERXIEN) ;Retrieve the Erx Hold Status, Reason, and Hold By
- +1 ; Input : ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
- +2 ; Output: ERXHLDARY - An array which must be passed in by reference; returned with the following:
- +3 ; ERXHLDARY(#)=value or if no hold status ERXHLDARY(0)=""
- +4 ; Where:
- +5 ; # - is a sequential number greater than zero
- +6 ; value - is a line of text
- +7 ; 1-Hold Status
- +8 ; 2-Hold Reason
- +9 ; 3-Hold Entered By
- +10 NEW CURSTATE,CURSTATI,CNTR,HARY,HL,LHMATCH,LHFOUND,LHSTATI
- +11 KILL ERXHLDARY
- +12 ; only set the hold reason if the eRx has a hold status and hold reason contains data
- +13 SET CURSTATE=$$GET1^DIQ(52.49,ERXIEN,1,"E")
- +14 SET (VAHSTA,VAHREA,VAHPER)=""
- +15 SET CNTR=0
- +16 IF $EXTRACT(CURSTATE,1)="H"
- Begin DoDot:1
- +17 SET CURSTATI=$$GET1^DIQ(52.49,ERXIEN,1,"I")
- +18 SET LHMATCH=999999
- SET LHFOUND=0
- FOR
- SET LHMATCH=$ORDER(^PS(52.49,ERXIEN,19,LHMATCH),-1)
- if 'LHMATCH!(LHFOUND)
- QUIT
- Begin DoDot:2
- +19 SET LHSTATI=$$GET1^DIQ(52.4919,LHMATCH_","_ERXIEN_",",.02,"I")
- IF LHSTATI=CURSTATI
- Begin DoDot:3
- +20 SET VAHSTA=$$GET1^DIQ(52.45,LHSTATI,.01,"E")_" - "_$$GET1^DIQ(52.45,LHSTATI,.02,"E")
- SET CNTR=CNTR+1
- SET ERXHLDARY($JOB,CNTR)=VAHSTA
- +21 SET VAHPER=$$GET1^DIQ(52.4919,LHMATCH_","_ERXIEN_",",.03,"E")
- SET CNTR=CNTR+1
- SET ERXHLDARY($JOB,CNTR)=VAHPER
- +22 SET VAHREA=$$GET1^DIQ(52.4919,LHMATCH_","_ERXIEN_",",1)
- SET CNTR=CNTR+1
- SET ERXHLDARY($JOB,CNTR)=VAHREA
- End DoDot:3
- SET LHFOUND=LHMATCH
- QUIT
- End DoDot:2
- End DoDot:1
- +23 IF CNTR<1
- SET ERXHLDARY($JOB,0)=""
- +24 QUIT $GET(CNTR)
- +25 ;
- GETERXRDT(ERXIEN) ;Retrieve the eRx Received Date time stamp
- +1 ; Input : ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
- +2 ; Output: ERXRADT - eRx Recieved Date time stamp^accepted by^date accepted
- +3 ; Example: 1/19/24@14:05^LASTNAME,FIRSTNAME^9/26/24@10:30
- +4 NEW ACCDTBY,ERXRADT
- +5 if '$GET(ERXIEN)
- QUIT
- +6 SET ACCDTBY=$$ACCDTBY^PSOERUT4(ERXIEN)
- +7 SET ERXRADT=$PIECE($$FMTE^XLFDT($$GET1^DIQ(52.49,ERXIEN,.03,"I"),"2Y"),":",1,2)
- +8 SET ERXRADT=ERXRADT_"^"_$EXTRACT($PIECE(ACCDTBY,"^",2),1,17)_"^"_$PIECE($PIECE(ACCDTBY,"^",1),":",1,2)
- +9 QUIT $GET(ERXRADT)
- +10 ;
- REF ;Screen Refresh
- +1 IF $DATA(VALMEVL)
- FOR I=1:1:99
- DO RESTORE^VALM10(I)
- +2 DO HDR
- DO INIT
- SET VALMBCK="R"
- +3 QUIT
- +4 ;
- VO ; View Original eRx Action
- +1 NEW ORERXIEN,ERX
- +2 SET ORERXIEN=$$RELERX(ERXIEN,"N")
- +3 IF ORERXIEN
- SET (ERXIEN,PSOIEN)=ORERXIEN
- +4 IF '$TEST
- IF ORERXIEN=0
- SET VALMSG="No Original eRx Found"
- SET VALMBCK="R"
- WRITE $CHAR(7)
- QUIT
- +5 DO REF
- +6 QUIT
- +7 ;
- VRR ; View Request
- +1 NEW RRERXIEN,ERX
- +2 SET RRERXIEN=$$RELERX(ERXIEN,"RR,CR,CA")
- +3 IF RRERXIEN
- SET (ERXIEN,PSOIEN)=RRERXIEN
- +4 IF '$TEST
- IF RRERXIEN=0
- SET VALMSG="No Request eRx Found"
- SET VALMBCK="R"
- WRITE $CHAR(7)
- QUIT
- +5 DO REF
- +6 QUIT
- +7 ;
- VRE ; View Request Response
- +1 NEW REERXIEN,ERX
- +2 SET REERXIEN=$$RELERX(ERXIEN,"RE,CN,CX")
- +3 IF REERXIEN
- SET (ERXIEN,PSOIEN)=REERXIEN
- +4 IF '$TEST
- IF REERXIEN=0
- SET VALMSG="No Response eRx Found"
- SET VALMBCK="R"
- WRITE $CHAR(7)
- QUIT
- +5 DO REF
- +6 QUIT
- +7 ;
- RELERX(ERXIEN,MSGTYPE) ; Returns the Selected Related eRx IEN
- +1 ; Input: ERXIEN - Pointer to ERX HOLDING QUEUE (#52.49)
- +2 ; MSGTYPE - Relation types ("N":NewRx;"RR,CR,CA":Request;"RE,CN,CX":Response)
- +3 ;Output: RELERX - Selected Related eRx (Original, Response, Request) - Pointer to #52.49 (0 if not found)
- +4 NEW ERX,ERXARR,TMPARR,X,Y,DTOUT,DIROUT,SEQ,DIR,XX,RERX,REQIEN,RESIEN,ORIGIEN,MTYPE
- +5 SET (SEQ,ERX)=0
- +6 FOR
- SET ERX=$ORDER(^PS(52.49,ERXIEN,201,"B",ERX))
- if 'ERX
- QUIT
- Begin DoDot:1
- +7 IF '$DATA(TMPARR(ERX))
- IF ","_MSGTYPE_","[(","_$$GET1^DIQ(52.49,ERX,.08,"I")_",")
- Begin DoDot:2
- +8 SET SEQ=SEQ+1
- SET ERXARR(SEQ)=ERX
- SET TMPARR(ERX)=""
- End DoDot:2
- +9 IF '$TEST
- SET RERX=0
- FOR
- SET RERX=$ORDER(^PS(52.49,ERX,201,"B",RERX))
- if 'RERX
- QUIT
- Begin DoDot:2
- +10 IF '$DATA(TMPARR(RERX))
- IF ","_MSGTYPE_","[(","_$$GET1^DIQ(52.49,RERX,.08,"I")_",")
- Begin DoDot:3
- +11 SET SEQ=SEQ+1
- SET ERXARR(SEQ)=RERX
- SET TMPARR(RERX)=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +12 ;
- +13 IF '$DATA(ERXARR)
- Begin DoDot:1
- +14 SET MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
- +15 SET (ORIGIEN,REQIEN,RESIEN)=0
- +16 IF ",RR,CA,CR,"[(","_MTYPE_",")
- Begin DoDot:2
- +17 SET REQIEN=ERXIEN
- SET RESIEN=$$GETRESP^PSOERXU2(ERXIEN)
- End DoDot:2
- +18 IF ",RE,CN,CX,"[(","_MTYPE_",")
- Begin DoDot:2
- +19 SET RESIEN=ERXIEN
- SET REQIEN=$$RESOLV^PSOERXU2(ERXIEN)
- End DoDot:2
- +20 IF MTYPE="IE"
- Begin DoDot:2
- +21 SET RESIEN=ERXIEN
- SET REQIEN=$$RESOLV^PSOERXU2(ERXIEN)
- End DoDot:2
- +22 IF $GET(REQIEN)
- Begin DoDot:2
- +23 SET ORIGIEN=+$ORDER(^PS(52.49,"B",+$$GET1^DIQ(52.49,REQIEN,.14),0))
- End DoDot:2
- +24 IF MSGTYPE="N"
- IF $GET(ORIGIEN)
- IF ORIGIEN'=ERXIEN
- SET SEQ=SEQ+1
- SET ERXARR(SEQ)=ORIGIEN
- +25 IF MSGTYPE="RR,CR,CA"
- IF $GET(REQIEN)
- SET SEQ=SEQ+1
- SET ERXARR(SEQ)=REQIEN
- +26 IF MSGTYPE="RE,CN,CX"
- IF $GET(RESIEN)
- SET SEQ=SEQ+1
- SET ERXARR(SEQ)=RESIEN
- End DoDot:1
- +27 ;
- +28 IF '$DATA(ERXARR)
- QUIT 0
- +29 IF '$DATA(ERXARR(2))
- QUIT $GET(ERXARR(1))
- +30 DO FULL^VALM1
- +31 WRITE !!,"# ERX ID",?22,"ERX TYPE",?42,"STATUS",?50,"DATE/TIME"
- +32 SET XX=""
- SET $PIECE(XX,"-",72)=""
- WRITE !,XX
- +33 SET SEQ=0
- FOR
- SET SEQ=$ORDER(ERXARR(SEQ))
- if 'SEQ
- QUIT
- Begin DoDot:1
- +34 SET ERX=ERXARR(SEQ)
- WRITE !,SEQ,?3,$$GET1^DIQ(52.49,ERX,.01),?22,$$GET1^DIQ(52.49,ERX,.08),?42,$$GET1^DIQ(52.49,ERX,1),?50,$$GET1^DIQ(52.49,ERX,.03)
- End DoDot:1
- +35 WRITE !
- SET DIR(0)="L^1:"_$ORDER(ERXARR(999),-1)
- SET DIR("A")="SELECT"
- +36 DO ^DIR
- IF $DATA(DIRUT)!$DATA(DIROUT)
- QUIT "^"
- +37 QUIT ERXARR(+Y)
- +38 QUIT
- +39 ;
- DEANOTE(LINE) ;DEA Note for CS Digitally Signed eRx records
- +1 NEW LINETXT
- +2 SET LINE=LINE+1
- DO SET^VALM10(LINE,"")
- +3 SET LINE=LINE+1
- SET LINETXT=" This prescription meets the requirements of the Drug Enforcement Administration"
- +4 DO SET^VALM10(LINE,LINETXT)
- DO CNTRL^VALM10(LINE,1,$LENGTH(LINETXT)+1,IOINHI,IOINORM)
- +5 SET LINE=LINE+1
- SET LINETXT=" (DEA) electronic prescribing for controlled substances rules (21 CFR Parts 1300,"
- +6 DO SET^VALM10(LINE,LINETXT)
- DO CNTRL^VALM10(LINE,1,$LENGTH(LINETXT)+1,IOINHI,IOINORM)
- +7 SET LINE=LINE+1
- SET LINETXT=" 1304, 1306, & 1311)."
- +8 DO SET^VALM10(LINE,LINETXT)
- DO CNTRL^VALM10(LINE,2,$LENGTH(LINETXT),IOINHI,IOINORM)
- +9 SET LINE=LINE+1
- +10 QUIT