- PSXMSGS ;BIR/WPB - Miscellaneous Message Handler ;01 JUL 1997 1:55 PM
- ;;2.0;CMOP;**1,2,4,24,23,27,30,41,77**;11 Apr 97;Build 3
- ;Reference to ^PS(59 supported by DBIA #1976
- ;Reference to File #200 supported by DBIA #10060
- ;Reference to DIQ^PSODI supported by DBIA #4858
- ;Reference to STATUS^PSOBPSUT supported by DBIA #4701
- ;
- CAN ;Q:'$D(^TMP("PSXCAN1",$J))
- S DV="" F S DV=$O(^TMP("PSXCAN1",$J,DV)) Q:DV="" S DIVN=$P(^PS(59,DV,0),"^") D PNM
- Q
- PNM S XMSUB=DIVN_" CMOP Not Dispensed Rx List, ",XMDUZ=.5,XMDUN="CMOP Manager"
- D XMZ^XMA2 G:XMZ<0 CAN
- N SYM,RXN
- S LCNT=1,^XMB(3.9,XMZ,2,LCNT,0)="Not Dispensed Rx Report for the "_DIVN_" Division.",LCNT=LCNT+1
- S ^XMB(3.9,XMZ,2,LCNT,0)="",LCNT=LCNT+1
- S ^XMB(3.9,XMZ,2,LCNT,0)="The following prescriptions were not dispensed by the vendor: ",LCNT=LCNT+1
- S ^XMB(3.9,XMZ,2,LCNT,0)="",LCNT=LCNT+1
- S DFN="" F S DFN=$O(^TMP("PSXCAN1",$J,DV,DFN)) Q:DFN="" S PNM=$P(^DPT(DFN,0),"^"),SSN1=$P(^DPT(DFN,0),"^",9),SPS=(47-$L(PNM)),PSXSSN=$E(SSN1,1,3)_"-"_$E(SSN1,4,5)_"-"_$E(SSN1,6,9) D
- .F I=1:1:SPS S SP=$G(SP)_" "
- .S ^XMB(3.9,XMZ,2,LCNT,0)="Patient: "_PNM_SP_"SSN: "_PSXSSN,LCNT=LCNT+1
- .S ^XMB(3.9,XMZ,2,LCNT,0)="",LCNT=LCNT+1
- .S RX1="" F S RX1=$O(^TMP("PSXCAN1",$J,DV,DFN,RX1)) Q:RX1="" D
- ..S NODE=^TMP("PSXCAN1",$J,DV,DFN,RX1)
- ..S REASON=$P(NODE,"^",6),BT=$P(NODE,"^",8),FIL=$P(NODE,"^",7)
- ..S RXN=$O(^PSRX("B",RX1,""))
- ..S SYM=$S(+$$RXAPI1(RXN,105,"I"):"$",1:"")_$$ECME(RXN)
- ..S FLL=$S(FIL>0:"REFILL "_FIL,FIL=0:"ORIGINAL",1:"")
- ..S DRGN=$S($P($G(NODE),"^",1)'="":$P(NODE,"^",1),1:"UNKNOWN")
- ..S DRGI=$P(NODE,"^",4),CMOPYN=$P(NODE,"^",5),QY=$P(NODE,"^",3)
- ..S ^XMB(3.9,XMZ,2,LCNT,0)=" Rx #: "_RX1_SYM_" "_$S(FIL'>0:"(ORG)",FIL>0:"(REF"_FIL_")",1:"")_" Qty: "_QY_" Trans #: "_BT,LCNT=LCNT+1
- ..S ^XMB(3.9,XMZ,2,LCNT,0)=" Drug: "_DRGN,LCNT=LCNT+1
- ..S ^XMB(3.9,XMZ,2,LCNT,0)=" Transmitted under CMOP ID: "_$G(DRGI),LCNT=LCNT+1
- ..S ^XMB(3.9,XMZ,2,LCNT,0)=" Reason: "_REASON,LCNT=LCNT+1
- ..I $G(CMOPYN)=1 S ^XMB(3.9,XMZ,2,LCNT,0)=" Note: Local Drug File entry is no longer MARKED for CMOP ",LCNT=LCNT+1
- ..S:$P(NODE,"^",2)'=$G(DRGI) ^XMB(3.9,XMZ,2,LCNT,0)=" Note: Local Drug File entry is no longer MATCHED to transmitted CMOP I.D. ",LCNT=LCNT+1
- ..S ^XMB(3.9,XMZ,2,LCNT,0)=" ",LCNT=LCNT+1
- ..K CMOPYN,FLL,FIL,BT,REASON,DRGI,DRGN,QY,I,SP,SPS,SP1
- S ^XMB(3.9,XMZ,2,LCNT,0)="Instructions: Prescriptions cannot be processed at CMOP for the reason listed",LCNT=LCNT+1
- S ^XMB(3.9,XMZ,2,LCNT,0)="above. Please review the prescription and take the appropriate action(s).",LCNT=LCNT+1
- S ^XMB(3.9,XMZ,2,LCNT,0)="If you have any questions, contact your CMOP contact person.",LCNT=LCNT+1
- S ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_"^"_LCNT_"^"_DT,XMDUN="CMOP Manager"
- K XMY D GRP S XMDUZ=.5 D ENT1^XMD
- K XMY,XMDUZ,XMSUB,XMDUN,REASON,RXN,LCNT,XMZ,FILL,FIL,TDT,TDTM,BAT,DOMAIN,PTR,XPTR,FACDOM
- Q
- INVREL S XMSUB="CMOP Release Return Problems",XMDUZ=DUZ,XMDUN="CMOP Manager"
- D XMZ^XMA2 G:XMZ<0 INVREL
- S LCNT=1
- S RXNN="" F S RXNN=$O(^TMP($J,"PSXINV",RXNN)) Q:RXNN="" D
- .S ^XMB(3.9,XMZ,2,LCNT,0)=RXNN_" has already been marked as processed",LCNT=LCNT+1
- S ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_"^"_LCNT_"^"_DT,XMDUN="CMOP Manager",XMDUZ=DUZ
- K XMY S XMY(DUZ)="" D ENT1^XMD
- Q
- AUTOMSG N TSK D NOW^%DTC S DTE=$$FMTE^XLFDT(%,1),SITE=$P($G(PSXSYS),U,3) K %
- I $G(PSXCS)'=1 G NONCS ; If not controlled subs
- D OPTSTAT^XUTMOPT("PSXR SCHEDULED CS TRANS",.TSK)
- S DTTM=$P($G(TSK(1)),U,2),NUM=+$P($G(TSK(1)),U,3),THRU=$$GET1^DIQ(550,+PSXSYS,12)
- G MSG1
- NONCS ;
- D OPTSTAT^XUTMOPT("PSXR SCHEDULED NON-CS TRANS",.TSK)
- S DTTM=$P($G(TSK(1)),U,2),NUM=+$P($G(TSK(1)),U,3),THRU=$$GET1^DIQ(550,+PSXSYS,11)
- MSG1 S XMDUZ=.5,XMSUB="CMOP "_$S($G(PSXCS)=1:"CS ",1:"")_"Auto-Transmission Schedule",LCNT=1
- I DTTM S Y=DTTM X ^DD("DD") S DTTM=Y I 1
- E S DTTM="NONE - Canceled",(NUM,THRU)=""
- D XMZ^XMA2 G:XMZ<1 AUTOMSG
- S ^XMB(3.9,XMZ,2,LCNT,0)=$S(DTTM["NONE":"<CANCEL> ",1:"")_$S($G(PSXCS)=1:"CS ",1:"")_"Auto-transmission Schedule.",LCNT=LCNT+1
- S ^XMB(3.9,XMZ,2,LCNT,0)="",LCNT=LCNT+1
- S ^XMB(3.9,XMZ,2,LCNT,0)="Facility : "_SITE,LCNT=LCNT+1
- S ^XMB(3.9,XMZ,2,LCNT,0)="Date Initiated : "_$P(DTE,":",1,2),LCNT=LCNT+1
- S ^XMB(3.9,XMZ,2,LCNT,0)="Begin Automatic Transmissions : "_DTTM,LCNT=LCNT+1
- S ^XMB(3.9,XMZ,2,LCNT,0)="Number of days to transmit thru: "_$S((($G(THRU)'>0)&(+NUM)):"Current date",1:$G(THRU)),LCNT=LCNT+1
- S ^XMB(3.9,XMZ,2,LCNT,0)="Scheduling Frequency (hours) : "_NUM,LCNT=LCNT+1
- S ^XMB(3.9,XMZ,2,LCNT,0)="Initiating Official : "_$$GET1^DIQ(200,DUZ,.01),LCNT=LCNT+1
- S ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_"^"_LCNT_"^"_DT,XMDUN="CMOP Manager"
- K XMY S XMDUZ=.5
- D GRP^PSXNOTE
- ;S XMY(DUZ)=""
- D ENT1^XMD
- Q
- GRP I '$D(^XUSEC("PSXMAIL")) G GRP1
- F MDUZ=0:0 S MDUZ=$O(^XUSEC("PSXMAIL",MDUZ)) Q:MDUZ'>0 S XMY(MDUZ)="",XQA(MDUZ)=""
- K MDUZ
- G:'$D(XMY) GRP1
- Q
- GRP1 F XDUZ=0:0 S XDUZ=$O(^XUSEC("PSXCMOPMGR",XDUZ)) Q:XDUZ'>0 S XMY(XDUZ)="",XQA(XDUZ)=""
- K XDUZ
- Q
- ;
- RXAPI1(IEN,FLD,FORMAT) ;
- ; Use standard PRE APIs to get Prescription data
- ; Reference to DIQ^PSODI supported by DBIA #4858
- ;
- ; Input
- ; IEN: Prescription file IEN
- ; FLD: Prescription field
- ; FORMAT: E-External (Default)
- ; I-Internal
- ; N-Do not return nulls
- ; Output: Data from Prescription in requested format
- ;
- I '$G(IEN)!($G(FLD)="") Q ""
- N DIQ,DIC,PSXARR,X,Y,D0,PSODIY
- N I,J,C,DA,DRS,DIL,DI,DIQ1,PSXDIQ
- S PSXDIQ="PSXARR"
- S PSXDIQ(0)=$S($G(FORMAT)="":"E",1:FORMAT)
- D DIQ^PSODI(52,52,.FLD,.IEN,.PSXDIQ) ;DBIA 4858
- Q $S(PSXDIQ(0)="N":$G(PSXARR(52,IEN,FLD)),1:$G(PSXARR(52,IEN,FLD,PSXDIQ(0))))
- ;
- ECME(RX) ;
- ; Returns "e" if last Rx/Refill is Electronically Billable (3rd party)
- ; Reference to STATUS^PSOBPSUT supported by DBIA #4701
- ;
- ; Input:
- ; RX: Prescription IEN (required)
- ; Output:
- ; Null: Not electronically billable to ePharmacy
- ; 'e': Electronically billable to ePharmacy
- ;
- I '$G(RX) Q ""
- Q $S($$STATUS^PSOBPSUT(RX)'="":"e",1:"")
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXMSGS 6101 printed Feb 18, 2025@23:10:54 Page 2
- PSXMSGS ;BIR/WPB - Miscellaneous Message Handler ;01 JUL 1997 1:55 PM
- +1 ;;2.0;CMOP;**1,2,4,24,23,27,30,41,77**;11 Apr 97;Build 3
- +2 ;Reference to ^PS(59 supported by DBIA #1976
- +3 ;Reference to File #200 supported by DBIA #10060
- +4 ;Reference to DIQ^PSODI supported by DBIA #4858
- +5 ;Reference to STATUS^PSOBPSUT supported by DBIA #4701
- +6 ;
- CAN ;Q:'$D(^TMP("PSXCAN1",$J))
- +1 SET DV=""
- FOR
- SET DV=$ORDER(^TMP("PSXCAN1",$JOB,DV))
- if DV=""
- QUIT
- SET DIVN=$PIECE(^PS(59,DV,0),"^")
- DO PNM
- +2 QUIT
- PNM SET XMSUB=DIVN_" CMOP Not Dispensed Rx List, "
- SET XMDUZ=.5
- SET XMDUN="CMOP Manager"
- +1 DO XMZ^XMA2
- if XMZ<0
- GOTO CAN
- +2 NEW SYM,RXN
- +3 SET LCNT=1
- SET ^XMB(3.9,XMZ,2,LCNT,0)="Not Dispensed Rx Report for the "_DIVN_" Division."
- SET LCNT=LCNT+1
- +4 SET ^XMB(3.9,XMZ,2,LCNT,0)=""
- SET LCNT=LCNT+1
- +5 SET ^XMB(3.9,XMZ,2,LCNT,0)="The following prescriptions were not dispensed by the vendor: "
- SET LCNT=LCNT+1
- +6 SET ^XMB(3.9,XMZ,2,LCNT,0)=""
- SET LCNT=LCNT+1
- +7 SET DFN=""
- FOR
- SET DFN=$ORDER(^TMP("PSXCAN1",$JOB,DV,DFN))
- if DFN=""
- QUIT
- SET PNM=$PIECE(^DPT(DFN,0),"^")
- SET SSN1=$PIECE(^DPT(DFN,0),"^",9)
- SET SPS=(47-$LENGTH(PNM))
- SET PSXSSN=$EXTRACT(SSN1,1,3)_"-"_$EXTRACT(SSN1,4,5)_"-"_$EXTRACT(SSN1,6,9)
- Begin DoDot:1
- +8 FOR I=1:1:SPS
- SET SP=$GET(SP)_" "
- +9 SET ^XMB(3.9,XMZ,2,LCNT,0)="Patient: "_PNM_SP_"SSN: "_PSXSSN
- SET LCNT=LCNT+1
- +10 SET ^XMB(3.9,XMZ,2,LCNT,0)=""
- SET LCNT=LCNT+1
- +11 SET RX1=""
- FOR
- SET RX1=$ORDER(^TMP("PSXCAN1",$JOB,DV,DFN,RX1))
- if RX1=""
- QUIT
- Begin DoDot:2
- +12 SET NODE=^TMP("PSXCAN1",$JOB,DV,DFN,RX1)
- +13 SET REASON=$PIECE(NODE,"^",6)
- SET BT=$PIECE(NODE,"^",8)
- SET FIL=$PIECE(NODE,"^",7)
- +14 SET RXN=$ORDER(^PSRX("B",RX1,""))
- +15 SET SYM=$SELECT(+$$RXAPI1(RXN,105,"I"):"$",1:"")_$$ECME(RXN)
- +16 SET FLL=$SELECT(FIL>0:"REFILL "_FIL,FIL=0:"ORIGINAL",1:"")
- +17 SET DRGN=$SELECT($PIECE($GET(NODE),"^",1)'="":$PIECE(NODE,"^",1),1:"UNKNOWN")
- +18 SET DRGI=$PIECE(NODE,"^",4)
- SET CMOPYN=$PIECE(NODE,"^",5)
- SET QY=$PIECE(NODE,"^",3)
- +19 SET ^XMB(3.9,XMZ,2,LCNT,0)=" Rx #: "_RX1_SYM_" "_$SELECT(FIL'>0:"(ORG)",FIL>0:"(REF"_FIL_")",1:"")_" Qty: "_QY_" Trans #: "_BT
- SET LCNT=LCNT+1
- +20 SET ^XMB(3.9,XMZ,2,LCNT,0)=" Drug: "_DRGN
- SET LCNT=LCNT+1
- +21 SET ^XMB(3.9,XMZ,2,LCNT,0)=" Transmitted under CMOP ID: "_$GET(DRGI)
- SET LCNT=LCNT+1
- +22 SET ^XMB(3.9,XMZ,2,LCNT,0)=" Reason: "_REASON
- SET LCNT=LCNT+1
- +23 IF $GET(CMOPYN)=1
- SET ^XMB(3.9,XMZ,2,LCNT,0)=" Note: Local Drug File entry is no longer MARKED for CMOP "
- SET LCNT=LCNT+1
- +24 if $PIECE(NODE,"^",2)'=$GET(DRGI)
- SET ^XMB(3.9,XMZ,2,LCNT,0)=" Note: Local Drug File entry is no longer MATCHED to transmitted CMOP I.D. "
- SET LCNT=LCNT+1
- +25 SET ^XMB(3.9,XMZ,2,LCNT,0)=" "
- SET LCNT=LCNT+1
- +26 KILL CMOPYN,FLL,FIL,BT,REASON,DRGI,DRGN,QY,I,SP,SPS,SP1
- End DoDot:2
- End DoDot:1
- +27 SET ^XMB(3.9,XMZ,2,LCNT,0)="Instructions: Prescriptions cannot be processed at CMOP for the reason listed"
- SET LCNT=LCNT+1
- +28 SET ^XMB(3.9,XMZ,2,LCNT,0)="above. Please review the prescription and take the appropriate action(s)."
- SET LCNT=LCNT+1
- +29 SET ^XMB(3.9,XMZ,2,LCNT,0)="If you have any questions, contact your CMOP contact person."
- SET LCNT=LCNT+1
- +30 SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_"^"_LCNT_"^"_DT
- SET XMDUN="CMOP Manager"
- +31 KILL XMY
- DO GRP
- SET XMDUZ=.5
- DO ENT1^XMD
- +32 KILL XMY,XMDUZ,XMSUB,XMDUN,REASON,RXN,LCNT,XMZ,FILL,FIL,TDT,TDTM,BAT,DOMAIN,PTR,XPTR,FACDOM
- +33 QUIT
- INVREL SET XMSUB="CMOP Release Return Problems"
- SET XMDUZ=DUZ
- SET XMDUN="CMOP Manager"
- +1 DO XMZ^XMA2
- if XMZ<0
- GOTO INVREL
- +2 SET LCNT=1
- +3 SET RXNN=""
- FOR
- SET RXNN=$ORDER(^TMP($JOB,"PSXINV",RXNN))
- if RXNN=""
- QUIT
- Begin DoDot:1
- +4 SET ^XMB(3.9,XMZ,2,LCNT,0)=RXNN_" has already been marked as processed"
- SET LCNT=LCNT+1
- End DoDot:1
- +5 SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_"^"_LCNT_"^"_DT
- SET XMDUN="CMOP Manager"
- SET XMDUZ=DUZ
- +6 KILL XMY
- SET XMY(DUZ)=""
- DO ENT1^XMD
- +7 QUIT
- AUTOMSG NEW TSK
- DO NOW^%DTC
- SET DTE=$$FMTE^XLFDT(%,1)
- SET SITE=$PIECE($GET(PSXSYS),U,3)
- KILL %
- +1 ; If not controlled subs
- IF $GET(PSXCS)'=1
- GOTO NONCS
- +2 DO OPTSTAT^XUTMOPT("PSXR SCHEDULED CS TRANS",.TSK)
- +3 SET DTTM=$PIECE($GET(TSK(1)),U,2)
- SET NUM=+$PIECE($GET(TSK(1)),U,3)
- SET THRU=$$GET1^DIQ(550,+PSXSYS,12)
- +4 GOTO MSG1
- NONCS ;
- +1 DO OPTSTAT^XUTMOPT("PSXR SCHEDULED NON-CS TRANS",.TSK)
- +2 SET DTTM=$PIECE($GET(TSK(1)),U,2)
- SET NUM=+$PIECE($GET(TSK(1)),U,3)
- SET THRU=$$GET1^DIQ(550,+PSXSYS,11)
- MSG1 SET XMDUZ=.5
- SET XMSUB="CMOP "_$SELECT($GET(PSXCS)=1:"CS ",1:"")_"Auto-Transmission Schedule"
- SET LCNT=1
- +1 IF DTTM
- SET Y=DTTM
- XECUTE ^DD("DD")
- SET DTTM=Y
- IF 1
- +2 IF '$TEST
- SET DTTM="NONE - Canceled"
- SET (NUM,THRU)=""
- +3 DO XMZ^XMA2
- if XMZ<1
- GOTO AUTOMSG
- +4 SET ^XMB(3.9,XMZ,2,LCNT,0)=$SELECT(DTTM["NONE":"<CANCEL> ",1:"")_$SELECT($GET(PSXCS)=1:"CS ",1:"")_"Auto-transmission Schedule."
- SET LCNT=LCNT+1
- +5 SET ^XMB(3.9,XMZ,2,LCNT,0)=""
- SET LCNT=LCNT+1
- +6 SET ^XMB(3.9,XMZ,2,LCNT,0)="Facility : "_SITE
- SET LCNT=LCNT+1
- +7 SET ^XMB(3.9,XMZ,2,LCNT,0)="Date Initiated : "_$PIECE(DTE,":",1,2)
- SET LCNT=LCNT+1
- +8 SET ^XMB(3.9,XMZ,2,LCNT,0)="Begin Automatic Transmissions : "_DTTM
- SET LCNT=LCNT+1
- +9 SET ^XMB(3.9,XMZ,2,LCNT,0)="Number of days to transmit thru: "_$SELECT((($GET(THRU)'>0)&(+NUM)):"Current date",1:$GET(THRU))
- SET LCNT=LCNT+1
- +10 SET ^XMB(3.9,XMZ,2,LCNT,0)="Scheduling Frequency (hours) : "_NUM
- SET LCNT=LCNT+1
- +11 SET ^XMB(3.9,XMZ,2,LCNT,0)="Initiating Official : "_$$GET1^DIQ(200,DUZ,.01)
- SET LCNT=LCNT+1
- +12 SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_"^"_LCNT_"^"_DT
- SET XMDUN="CMOP Manager"
- +13 KILL XMY
- SET XMDUZ=.5
- +14 DO GRP^PSXNOTE
- +15 ;S XMY(DUZ)=""
- +16 DO ENT1^XMD
- +17 QUIT
- GRP IF '$DATA(^XUSEC("PSXMAIL"))
- GOTO GRP1
- +1 FOR MDUZ=0:0
- SET MDUZ=$ORDER(^XUSEC("PSXMAIL",MDUZ))
- if MDUZ'>0
- QUIT
- SET XMY(MDUZ)=""
- SET XQA(MDUZ)=""
- +2 KILL MDUZ
- +3 if '$DATA(XMY)
- GOTO GRP1
- +4 QUIT
- GRP1 FOR XDUZ=0:0
- SET XDUZ=$ORDER(^XUSEC("PSXCMOPMGR",XDUZ))
- if XDUZ'>0
- QUIT
- SET XMY(XDUZ)=""
- SET XQA(XDUZ)=""
- +1 KILL XDUZ
- +2 QUIT
- +3 ;
- RXAPI1(IEN,FLD,FORMAT) ;
- +1 ; Use standard PRE APIs to get Prescription data
- +2 ; Reference to DIQ^PSODI supported by DBIA #4858
- +3 ;
- +4 ; Input
- +5 ; IEN: Prescription file IEN
- +6 ; FLD: Prescription field
- +7 ; FORMAT: E-External (Default)
- +8 ; I-Internal
- +9 ; N-Do not return nulls
- +10 ; Output: Data from Prescription in requested format
- +11 ;
- +12 IF '$GET(IEN)!($GET(FLD)="")
- QUIT ""
- +13 NEW DIQ,DIC,PSXARR,X,Y,D0,PSODIY
- +14 NEW I,J,C,DA,DRS,DIL,DI,DIQ1,PSXDIQ
- +15 SET PSXDIQ="PSXARR"
- +16 SET PSXDIQ(0)=$SELECT($GET(FORMAT)="":"E",1:FORMAT)
- +17 ;DBIA 4858
- DO DIQ^PSODI(52,52,.FLD,.IEN,.PSXDIQ)
- +18 QUIT $SELECT(PSXDIQ(0)="N":$GET(PSXARR(52,IEN,FLD)),1:$GET(PSXARR(52,IEN,FLD,PSXDIQ(0))))
- +19 ;
- ECME(RX) ;
- +1 ; Returns "e" if last Rx/Refill is Electronically Billable (3rd party)
- +2 ; Reference to STATUS^PSOBPSUT supported by DBIA #4701
- +3 ;
- +4 ; Input:
- +5 ; RX: Prescription IEN (required)
- +6 ; Output:
- +7 ; Null: Not electronically billable to ePharmacy
- +8 ; 'e': Electronically billable to ePharmacy
- +9 ;
- +10 IF '$GET(RX)
- QUIT ""
- +11 QUIT $SELECT($$STATUS^PSOBPSUT(RX)'="":"e",1:"")