- PSOERUT6 ;ALB/MFR - eRx & Pending Order Side-by-Side LM Display - Cont'd; 06/25/2023 5:14pm
- ;;7.0;OUTPATIENT PHARMACY;**700,746,769**;DEC 1997;Build 26
- ;
- EN ; Continuation of PSOERUT5 due to routine size limit
- ;
- ; - Provider
- S XE="Provider: "_$$COMPARE^PSOERUT0("LM",$E(ERXPRVNM,1,29),PENDATA("PROVIDER NAME"),11)
- S XV="|"_$S('RENEWORD:"13) ",1:"6) ")_"Provider: "_$$COMPARE^PSOERUT0("LM",$E(PENDATA("PROVIDER NAME"),1,26),ERXPRVNM,$S('RENEWORD:55,1:54))
- S UNDERLN(LINE,41)=$S('RENEWORD:3,1:2)
- D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
- S PRVIEN=$S($G(PENDATA("PROVIDER")):PENDATA("PROVIDER"),1:$$GET1^DIQ(52.41,ORDIEN,5,"I"))
- I $G(PKI),+$G(DRUGDATA("DEA"))>1,+$G(DRUGDATA("DEA"))<6 D
- . D CSPRV^PSOERUT4(PRVIEN,+VADRGIEN,$$GET1^DIQ(52.41,ORDIEN,.01,"I"))
- I $$GET1^DIQ(200,PRVIEN,53.7,"I"),$$GET1^DIQ(200,PRVIEN,53.8,"I") D
- . S XV="|Cos-Provider: "_$$COMPARE^PSOERUT0("LM",$$GET1^DIQ(200,PRVIEN,53.8),$$GET1^DIQ(200,PRVIEN,53.8),55)
- . D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
- D BLANKLN^PSOERUT0("LM")
- ;
- ; - Copies
- S VACLINIC=$$GET1^DIQ(52.41,ORDIEN,1.1)
- S COPIES=$S($G(PENDATA("COPIES")):PENDATA("COPIES"),1:1)
- S XV="|"_$S('RENEWORD:"14) ",1:"7) ")_"Copies: "_$$COMPARE^PSOERUT0("LM",COPIES,COPIES,$S('RENEWORD:53,1:52))
- S UNDERLN(LINE,41)=$S('RENEWORD:3,1:2)
- D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
- D BLANKLN^PSOERUT0("LM")
- ;
- ; - Remarks
- S VACLINIC=$$GET1^DIQ(52.41,ORDIEN,1.1)
- S XV="|"_$S('RENEWORD:"15) ",1:"8) ")_"Remarks: "
- S UNDERLN(LINE,41)=$S('RENEWORD:3,1:2)
- D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
- K VARR D WRAP^PSOERUT($G(PSONEW("REMARKS")),38,.VARR)
- F I=1:1 Q:'$D(VARR(I)) D
- . I $G(VARR(I,0))="" Q
- . D ADDLINE^PSOERUT0("LM",NMSPC,"","| "_$$COMPARE^PSOERUT0("LM",VARR(I,0),VARR(I,0),42))
- D BLANKLN^PSOERUT0("LM")
- ; - Diagnostics
- D SETDIAGS^PSOERUT3("LM",NMSPC,ERXIEN)
- ;
- ; - DEA compliance note for eRx CS prescriptions
- I $$GET1^DIQ(52.49,ERXIEN,95.1,"I"),$$CS^PSOERXA0(VADRGIEN) D
- . D BLANKLN^PSOERUT0("LM",1)
- . S XE=" This prescription meets the requirements of the Drug Enforcement Administration"
- . D ADDLINE^PSOERUT0("LM",NMSPC,$$COMPARE^PSOERUT0("LM",XE,XE,2))
- . S XE=" (DEA) electronic prescribing for controlled substances rules (21 CFR Parts"
- . D ADDLINE^PSOERUT0("LM",NMSPC,$$COMPARE^PSOERUT0("LM",XE,XE,2))
- . S XE=" 1300, 1304, 1306, & 1311)."
- . D ADDLINE^PSOERUT0("LM",NMSPC,$$COMPARE^PSOERUT0("LM",XE,XE,2))
- . D BLANKLN^PSOERUT0("LM",1)
- ;
- ; - Entry Accepted by/date/time
- S ACCDTBY=$$ACCDTBY^PSOERUT4(ERXIEN)
- S XX=" eRx Received on "_$P($$FMTE^XLFDT($$GET1^DIQ(52.49,ERXIEN,.03,"I"),"2Y"),":",1,2)
- S XX=XX_" | Accepted by "_$E($P(ACCDTBY,"^",2),1,17)_" on "_$P($P(ACCDTBY,"^",1),":",1,2)
- S XX=$E(XX,1,80),XE="",$E(XE,(80-$L(XX))\2+1)=XX
- D ADDLINE^PSOERUT0("LM",NMSPC,$$COMPARE^PSOERUT0("LM",XE,XE,2))
- Q
- ;
- VISTAPAT(ERXIEN) ; Returns the VistA Patient For Responses that pass through the eRx Holding Queue w/out matching/validation
- ; Input: ERXIEN - Pointer to the ERX HOLDING QUEUE (#52.49)
- ;Output: VISTAPAT - Pointer to the PATIENT file (#2) associated with the eRx
- N VISTAPAT,MTYPE,REQIEN,NEWRXIEN
- S VISTAPAT=+$$GET1^DIQ(52.49,ERXIEN,.05,"I")
- S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
- I 'VISTAPAT,"RR,CA,"[MTYPE D
- . S NEWRXIEN=$$RESOLV^PSOERXU2(ERXIEN)
- . S VISTAPAT=+$$GET1^DIQ(52.49,NEWRXIEN,.05,"I")
- I 'VISTAPAT,"RE,CN,IE,"[MTYPE D
- . S REQIEN=$$RESOLV^PSOERXU2(ERXIEN) Q:'REQIEN
- . S VISTAPAT=+$$GET1^DIQ(52.49,REQIEN,.05,"I") I VISTAPAT Q
- . S NEWRXIEN=$$RESOLV^PSOERXU2(REQIEN)
- . S VISTAPAT=+$$GET1^DIQ(52.49,NEWRXIEN,.05,"I")
- Q VISTAPAT
- ;
- CSERX(ORD) ; Check whether a Pending Order is for a CS eRx
- ; Input: ORD - Pointer to OUTPATIENT PENDING ORDER file (#52.41)
- I $$ERXIEN^PSOERXUT(ORD_"P"),$$CSDRG(+$$GET1^DIQ(52.41,+ORD,11,"I")) D Q 1
- . S VALMSG="Only the 'Routing' field can be edited (CS eRx).",VALMBCK="R" W $C(7)
- Q 0
- ;
- CSDRG(DRGIEN) ; Controlled Substance drug?
- ; Input: DRGIEN - Pointer to DRUG file (#50)
- ;Output: $$CS - 1:YES / 0:NO
- N DEA
- Q:'DRGIEN 0
- S DEA=$$GET1^DIQ(50,DRGIEN,3)
- I (DEA'["0"),(DEA'["M"),(DEA["2")!(DEA["3")!(DEA["4")!(DEA["5") Q 1
- Q 0
- ;
- VS(ERXIEN,TYPE) ; View Suggestion(s)
- ;Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
- ; TYPE - Type of Suggestion("PA": Patient;"PR": Provider;"DR": Drug)
- N ERXPAT,ERXPRV,DRUGHASH,ERX,VPRV,VPAT,RDAT
- S VALMBCK="R",(VPRVOK,VPATOK)=0
- I TYPE="PR" D
- . S ERXPRV=$$GET1^DIQ(52.49,ERXIEN,2.1,"I")
- . S VPRV=0 F S VPRV=$O(^PS(52.49,"APRVVPRV",ERXPRV,VPRV)) Q:'VPRV D I VPRVOK Q
- . . S RDAT=0 F S RDAT=$O(^PS(52.49,"APRVVPRV",ERXPRV,VPRV,RDAT)) Q:'RDAT D I VPRVOK Q
- . . . S ERX=0 F S ERX=$O(^PS(52.49,"APRVVPRV",ERXPRV,VPRV,RDAT,ERX)) Q:'ERX D I VPRVOK Q
- . . . . I ERX'=ERXIEN S VPRVOK=1
- I TYPE="PR",'VPRVOK D Q
- . S VALMSG="There are no suggestions for this Provider" W $C(7)
- I TYPE="PA" D
- . S ERXPAT=+$$GET1^DIQ(52.49,+$G(ERXIEN),.04,"I")
- . S VPAT=0 F S VPAT=$O(^PS(52.49,"APATVPAT",ERXPAT,VPAT)) Q:'VPAT D I VPATOK Q
- . . I $$DEAD^PSONVARP(VPAT) Q
- . . S RDAT=0 F S RDAT=$O(^PS(52.49,"APATVPAT",ERXPAT,VPAT,RDAT)) Q:'RDAT D I VPATOK Q
- . . . S ERX=0 F S ERX=$O(^PS(52.49,"APATVPAT",ERXPAT,VPAT,RDAT,ERX)) Q:'ERX D I VPATOK Q
- . . . . I ERX'=ERXIEN S VPATOK=1
- I TYPE="PA",'VPATOK D Q
- . S VALMSG="There are no suggestions for this Patient" W $C(7)
- I TYPE="DR" S DRUGHASH=$$DRUGHASH^PSOERUT(ERXIEN)
- I TYPE="DR",'DRUGHASH D Q
- . S VALMSG="Unable to calculate the hash value for this eRx" W $C(7)
- I TYPE="DR",'$O(^PS(52.49,"ADRGVRX",DRUGHASH,0)) D Q
- . S VALMSG="There are no suggestions for this Drug" W $C(7)
- D FULL^VALM1
- I TYPE="PA" D MATCHSUG^PSOERPT1(ERXIEN,1)
- I TYPE="PR" D MATCHSUG^PSOERPV1(ERXIEN,1)
- I TYPE="DR" D MATCHSUG^PSOERUT4(ERXIEN,1)
- Q
- ;
- LASTRXST(RXIEN) ; Returns the Rx Last Fill status (For Future Fill Suggestion only)
- ; Input: RXIEN - pointer to PRESCRIPTION file (#52)
- ;Output: STATUS - Last fill status ("R":Relased;"T":Transmitted;"S":Suspended)
- N LASTFILL,FILLDATE,RELDATE,RXSTS
- S LASTFILL=$$LSTRFL^PSOBPSU1(RXIEN)
- S RELDATE=$$RXRLDT^PSOBPSUT(RXIEN,LASTFILL)\1
- S RXSTS=+$$GET1^DIQ(52,RXIEN,100,"I")
- S FILLDATE=$$RXFLDT^PSOBPSUT(RXIEN,LASTFILL)
- ; Last Fill released, Release Date + Days Supply in the future
- I RELDATE,$$FMADD^XLFDT(RELDATE,$$GET1^DIQ(52,RXIEN,8))>DT Q "R"
- ; Last Fill is not released, is Suspended, Not Transmitted/Printed, Future Fill Date
- I 'RELDATE,(RXSTS=5),FILLDATE>DT Q "S"
- ; Last Fill is not released, is Transmitted or Re-Transmitted to CMOP
- I 'RELDATE,$$CMOPSTS^PSOERUT(RXIEN,LASTFILL)=0!($$CMOPSTS^PSOERUT(RXIEN,LASTFILL)=2) Q "T"
- Q ""
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERUT6 6652 printed Feb 18, 2025@23:54:34 Page 2
- PSOERUT6 ;ALB/MFR - eRx & Pending Order Side-by-Side LM Display - Cont'd; 06/25/2023 5:14pm
- +1 ;;7.0;OUTPATIENT PHARMACY;**700,746,769**;DEC 1997;Build 26
- +2 ;
- EN ; Continuation of PSOERUT5 due to routine size limit
- +1 ;
- +2 ; - Provider
- +3 SET XE="Provider: "_$$COMPARE^PSOERUT0("LM",$EXTRACT(ERXPRVNM,1,29),PENDATA("PROVIDER NAME"),11)
- +4 SET XV="|"_$SELECT('RENEWORD:"13) ",1:"6) ")_"Provider: "_$$COMPARE^PSOERUT0("LM",$EXTRACT(PENDATA("PROVIDER NAME"),1,26),ERXPRVNM,$SELECT('RENEWORD:55,1:54))
- +5 SET UNDERLN(LINE,41)=$SELECT('RENEWORD:3,1:2)
- +6 DO ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
- +7 SET PRVIEN=$SELECT($GET(PENDATA("PROVIDER")):PENDATA("PROVIDER"),1:$$GET1^DIQ(52.41,ORDIEN,5,"I"))
- +8 IF $GET(PKI)
- IF +$GET(DRUGDATA("DEA"))>1
- IF +$GET(DRUGDATA("DEA"))<6
- Begin DoDot:1
- +9 DO CSPRV^PSOERUT4(PRVIEN,+VADRGIEN,$$GET1^DIQ(52.41,ORDIEN,.01,"I"))
- End DoDot:1
- +10 IF $$GET1^DIQ(200,PRVIEN,53.7,"I")
- IF $$GET1^DIQ(200,PRVIEN,53.8,"I")
- Begin DoDot:1
- +11 SET XV="|Cos-Provider: "_$$COMPARE^PSOERUT0("LM",$$GET1^DIQ(200,PRVIEN,53.8),$$GET1^DIQ(200,PRVIEN,53.8),55)
- +12 DO ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
- End DoDot:1
- +13 DO BLANKLN^PSOERUT0("LM")
- +14 ;
- +15 ; - Copies
- +16 SET VACLINIC=$$GET1^DIQ(52.41,ORDIEN,1.1)
- +17 SET COPIES=$SELECT($GET(PENDATA("COPIES")):PENDATA("COPIES"),1:1)
- +18 SET XV="|"_$SELECT('RENEWORD:"14) ",1:"7) ")_"Copies: "_$$COMPARE^PSOERUT0("LM",COPIES,COPIES,$SELECT('RENEWORD:53,1:52))
- +19 SET UNDERLN(LINE,41)=$SELECT('RENEWORD:3,1:2)
- +20 DO ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
- +21 DO BLANKLN^PSOERUT0("LM")
- +22 ;
- +23 ; - Remarks
- +24 SET VACLINIC=$$GET1^DIQ(52.41,ORDIEN,1.1)
- +25 SET XV="|"_$SELECT('RENEWORD:"15) ",1:"8) ")_"Remarks: "
- +26 SET UNDERLN(LINE,41)=$SELECT('RENEWORD:3,1:2)
- +27 DO ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
- +28 KILL VARR
- DO WRAP^PSOERUT($GET(PSONEW("REMARKS")),38,.VARR)
- +29 FOR I=1:1
- if '$DATA(VARR(I))
- QUIT
- Begin DoDot:1
- +30 IF $GET(VARR(I,0))=""
- QUIT
- +31 DO ADDLINE^PSOERUT0("LM",NMSPC,"","| "_$$COMPARE^PSOERUT0("LM",VARR(I,0),VARR(I,0),42))
- End DoDot:1
- +32 DO BLANKLN^PSOERUT0("LM")
- +33 ; - Diagnostics
- +34 DO SETDIAGS^PSOERUT3("LM",NMSPC,ERXIEN)
- +35 ;
- +36 ; - DEA compliance note for eRx CS prescriptions
- +37 IF $$GET1^DIQ(52.49,ERXIEN,95.1,"I")
- IF $$CS^PSOERXA0(VADRGIEN)
- Begin DoDot:1
- +38 DO BLANKLN^PSOERUT0("LM",1)
- +39 SET XE=" This prescription meets the requirements of the Drug Enforcement Administration"
- +40 DO ADDLINE^PSOERUT0("LM",NMSPC,$$COMPARE^PSOERUT0("LM",XE,XE,2))
- +41 SET XE=" (DEA) electronic prescribing for controlled substances rules (21 CFR Parts"
- +42 DO ADDLINE^PSOERUT0("LM",NMSPC,$$COMPARE^PSOERUT0("LM",XE,XE,2))
- +43 SET XE=" 1300, 1304, 1306, & 1311)."
- +44 DO ADDLINE^PSOERUT0("LM",NMSPC,$$COMPARE^PSOERUT0("LM",XE,XE,2))
- +45 DO BLANKLN^PSOERUT0("LM",1)
- End DoDot:1
- +46 ;
- +47 ; - Entry Accepted by/date/time
- +48 SET ACCDTBY=$$ACCDTBY^PSOERUT4(ERXIEN)
- +49 SET XX=" eRx Received on "_$PIECE($$FMTE^XLFDT($$GET1^DIQ(52.49,ERXIEN,.03,"I"),"2Y"),":",1,2)
- +50 SET XX=XX_" | Accepted by "_$EXTRACT($PIECE(ACCDTBY,"^",2),1,17)_" on "_$PIECE($PIECE(ACCDTBY,"^",1),":",1,2)
- +51 SET XX=$EXTRACT(XX,1,80)
- SET XE=""
- SET $EXTRACT(XE,(80-$LENGTH(XX))\2+1)=XX
- +52 DO ADDLINE^PSOERUT0("LM",NMSPC,$$COMPARE^PSOERUT0("LM",XE,XE,2))
- +53 QUIT
- +54 ;
- VISTAPAT(ERXIEN) ; Returns the VistA Patient For Responses that pass through the eRx Holding Queue w/out matching/validation
- +1 ; Input: ERXIEN - Pointer to the ERX HOLDING QUEUE (#52.49)
- +2 ;Output: VISTAPAT - Pointer to the PATIENT file (#2) associated with the eRx
- +3 NEW VISTAPAT,MTYPE,REQIEN,NEWRXIEN
- +4 SET VISTAPAT=+$$GET1^DIQ(52.49,ERXIEN,.05,"I")
- +5 SET MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
- +6 IF 'VISTAPAT
- IF "RR,CA,"[MTYPE
- Begin DoDot:1
- +7 SET NEWRXIEN=$$RESOLV^PSOERXU2(ERXIEN)
- +8 SET VISTAPAT=+$$GET1^DIQ(52.49,NEWRXIEN,.05,"I")
- End DoDot:1
- +9 IF 'VISTAPAT
- IF "RE,CN,IE,"[MTYPE
- Begin DoDot:1
- +10 SET REQIEN=$$RESOLV^PSOERXU2(ERXIEN)
- if 'REQIEN
- QUIT
- +11 SET VISTAPAT=+$$GET1^DIQ(52.49,REQIEN,.05,"I")
- IF VISTAPAT
- QUIT
- +12 SET NEWRXIEN=$$RESOLV^PSOERXU2(REQIEN)
- +13 SET VISTAPAT=+$$GET1^DIQ(52.49,NEWRXIEN,.05,"I")
- End DoDot:1
- +14 QUIT VISTAPAT
- +15 ;
- CSERX(ORD) ; Check whether a Pending Order is for a CS eRx
- +1 ; Input: ORD - Pointer to OUTPATIENT PENDING ORDER file (#52.41)
- +2 IF $$ERXIEN^PSOERXUT(ORD_"P")
- IF $$CSDRG(+$$GET1^DIQ(52.41,+ORD,11,"I"))
- Begin DoDot:1
- +3 SET VALMSG="Only the 'Routing' field can be edited (CS eRx)."
- SET VALMBCK="R"
- WRITE $CHAR(7)
- End DoDot:1
- QUIT 1
- +4 QUIT 0
- +5 ;
- CSDRG(DRGIEN) ; Controlled Substance drug?
- +1 ; Input: DRGIEN - Pointer to DRUG file (#50)
- +2 ;Output: $$CS - 1:YES / 0:NO
- +3 NEW DEA
- +4 if 'DRGIEN
- QUIT 0
- +5 SET DEA=$$GET1^DIQ(50,DRGIEN,3)
- +6 IF (DEA'["0")
- IF (DEA'["M")
- IF (DEA["2")!(DEA["3")!(DEA["4")!(DEA["5")
- QUIT 1
- +7 QUIT 0
- +8 ;
- VS(ERXIEN,TYPE) ; View Suggestion(s)
- +1 ;Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
- +2 ; TYPE - Type of Suggestion("PA": Patient;"PR": Provider;"DR": Drug)
- +3 NEW ERXPAT,ERXPRV,DRUGHASH,ERX,VPRV,VPAT,RDAT
- +4 SET VALMBCK="R"
- SET (VPRVOK,VPATOK)=0
- +5 IF TYPE="PR"
- Begin DoDot:1
- +6 SET ERXPRV=$$GET1^DIQ(52.49,ERXIEN,2.1,"I")
- +7 SET VPRV=0
- FOR
- SET VPRV=$ORDER(^PS(52.49,"APRVVPRV",ERXPRV,VPRV))
- if 'VPRV
- QUIT
- Begin DoDot:2
- +8 SET RDAT=0
- FOR
- SET RDAT=$ORDER(^PS(52.49,"APRVVPRV",ERXPRV,VPRV,RDAT))
- if 'RDAT
- QUIT
- Begin DoDot:3
- +9 SET ERX=0
- FOR
- SET ERX=$ORDER(^PS(52.49,"APRVVPRV",ERXPRV,VPRV,RDAT,ERX))
- if 'ERX
- QUIT
- Begin DoDot:4
- +10 IF ERX'=ERXIEN
- SET VPRVOK=1
- End DoDot:4
- IF VPRVOK
- QUIT
- End DoDot:3
- IF VPRVOK
- QUIT
- End DoDot:2
- IF VPRVOK
- QUIT
- End DoDot:1
- +11 IF TYPE="PR"
- IF 'VPRVOK
- Begin DoDot:1
- +12 SET VALMSG="There are no suggestions for this Provider"
- WRITE $CHAR(7)
- End DoDot:1
- QUIT
- +13 IF TYPE="PA"
- Begin DoDot:1
- +14 SET ERXPAT=+$$GET1^DIQ(52.49,+$GET(ERXIEN),.04,"I")
- +15 SET VPAT=0
- FOR
- SET VPAT=$ORDER(^PS(52.49,"APATVPAT",ERXPAT,VPAT))
- if 'VPAT
- QUIT
- Begin DoDot:2
- +16 IF $$DEAD^PSONVARP(VPAT)
- QUIT
- +17 SET RDAT=0
- FOR
- SET RDAT=$ORDER(^PS(52.49,"APATVPAT",ERXPAT,VPAT,RDAT))
- if 'RDAT
- QUIT
- Begin DoDot:3
- +18 SET ERX=0
- FOR
- SET ERX=$ORDER(^PS(52.49,"APATVPAT",ERXPAT,VPAT,RDAT,ERX))
- if 'ERX
- QUIT
- Begin DoDot:4
- +19 IF ERX'=ERXIEN
- SET VPATOK=1
- End DoDot:4
- IF VPATOK
- QUIT
- End DoDot:3
- IF VPATOK
- QUIT
- End DoDot:2
- IF VPATOK
- QUIT
- End DoDot:1
- +20 IF TYPE="PA"
- IF 'VPATOK
- Begin DoDot:1
- +21 SET VALMSG="There are no suggestions for this Patient"
- WRITE $CHAR(7)
- End DoDot:1
- QUIT
- +22 IF TYPE="DR"
- SET DRUGHASH=$$DRUGHASH^PSOERUT(ERXIEN)
- +23 IF TYPE="DR"
- IF 'DRUGHASH
- Begin DoDot:1
- +24 SET VALMSG="Unable to calculate the hash value for this eRx"
- WRITE $CHAR(7)
- End DoDot:1
- QUIT
- +25 IF TYPE="DR"
- IF '$ORDER(^PS(52.49,"ADRGVRX",DRUGHASH,0))
- Begin DoDot:1
- +26 SET VALMSG="There are no suggestions for this Drug"
- WRITE $CHAR(7)
- End DoDot:1
- QUIT
- +27 DO FULL^VALM1
- +28 IF TYPE="PA"
- DO MATCHSUG^PSOERPT1(ERXIEN,1)
- +29 IF TYPE="PR"
- DO MATCHSUG^PSOERPV1(ERXIEN,1)
- +30 IF TYPE="DR"
- DO MATCHSUG^PSOERUT4(ERXIEN,1)
- +31 QUIT
- +32 ;
- LASTRXST(RXIEN) ; Returns the Rx Last Fill status (For Future Fill Suggestion only)
- +1 ; Input: RXIEN - pointer to PRESCRIPTION file (#52)
- +2 ;Output: STATUS - Last fill status ("R":Relased;"T":Transmitted;"S":Suspended)
- +3 NEW LASTFILL,FILLDATE,RELDATE,RXSTS
- +4 SET LASTFILL=$$LSTRFL^PSOBPSU1(RXIEN)
- +5 SET RELDATE=$$RXRLDT^PSOBPSUT(RXIEN,LASTFILL)\1
- +6 SET RXSTS=+$$GET1^DIQ(52,RXIEN,100,"I")
- +7 SET FILLDATE=$$RXFLDT^PSOBPSUT(RXIEN,LASTFILL)
- +8 ; Last Fill released, Release Date + Days Supply in the future
- +9 IF RELDATE
- IF $$FMADD^XLFDT(RELDATE,$$GET1^DIQ(52,RXIEN,8))>DT
- QUIT "R"
- +10 ; Last Fill is not released, is Suspended, Not Transmitted/Printed, Future Fill Date
- +11 IF 'RELDATE
- IF (RXSTS=5)
- IF FILLDATE>DT
- QUIT "S"
- +12 ; Last Fill is not released, is Transmitted or Re-Transmitted to CMOP
- +13 IF 'RELDATE
- IF $$CMOPSTS^PSOERUT(RXIEN,LASTFILL)=0!($$CMOPSTS^PSOERUT(RXIEN,LASTFILL)=2)
- QUIT "T"
- +14 QUIT ""