PSXMSGS ;BIR/WPB-Miscellaneous Message Handler ;01 JUL 1997 1:55 PM
;;2.0;CMOP;**1,2,4,24,23,27,30,41**;11 Apr 97
;Reference to ^PS(59 supported by DBIA #1976
;Reference to File #200 supported by DBIA #10060
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
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 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_" "_$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
PSXMSGS ;BIR/WPB-Miscellaneous Message Handler ;01 JUL 1997 1:55 PM
+1 ;;2.0;CMOP;**1,2,4,24,23,27,30,41**;11 Apr 97
+2 ;Reference to ^PS(59 supported by DBIA #1976
+3 ;Reference to File #200 supported by DBIA #10060
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 SET LCNT=1
SET ^XMB(3.9,XMZ,2,LCNT,0)="Not Dispensed Rx Report for the "_DIVN_" Division."
SET LCNT=LCNT+1
+3 SET ^XMB(3.9,XMZ,2,LCNT,0)=""
SET LCNT=LCNT+1
+4 SET ^XMB(3.9,XMZ,2,LCNT,0)="The following prescriptions were not dispensed by the vendor: "
SET LCNT=LCNT+1
+5 SET ^XMB(3.9,XMZ,2,LCNT,0)=""
SET LCNT=LCNT+1
+6 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
+7 FOR I=1:1:SPS
SET SP=$GET(SP)_" "
+8 SET ^XMB(3.9,XMZ,2,LCNT,0)="Patient: "_PNM_SP_"SSN: "_PSXSSN
SET LCNT=LCNT+1
+9 SET ^XMB(3.9,XMZ,2,LCNT,0)=""
SET LCNT=LCNT+1
+10 SET RX1=""
FOR
SET RX1=$ORDER(^TMP("PSXCAN1",$JOB,DV,DFN,RX1))
IF RX1=""
QUIT
Begin DoDot:2
+11 SET NODE=^TMP("PSXCAN1",$JOB,DV,DFN,RX1)
+12 SET REASON=$PIECE(NODE,"^",6)
SET BT=$PIECE(NODE,"^",8)
SET FIL=$PIECE(NODE,"^",7)
+13 SET FLL=$SELECT(FIL>0:"REFILL "_FIL,FIL=0:"ORIGINAL",1:"")
+14 SET DRGN=$SELECT($PIECE($GET(NODE),"^",1)'="":$PIECE(NODE,"^",1),1:"UNKNOWN")
+15 SET DRGI=$PIECE(NODE,"^",4)
SET CMOPYN=$PIECE(NODE,"^",5)
SET QY=$PIECE(NODE,"^",3)
+16 SET ^XMB(3.9,XMZ,2,LCNT,0)=" Rx #: "_RX1_" "_$SELECT(FIL'>0:"(ORG)",FIL>0:"(REF"_FIL_")",1:"")_" Qty: "_QY_" Trans #: "_BT
SET LCNT=LCNT+1
+17 SET ^XMB(3.9,XMZ,2,LCNT,0)=" Drug: "_DRGN
SET LCNT=LCNT+1
+18 SET ^XMB(3.9,XMZ,2,LCNT,0)=" Transmitted under CMOP ID: "_$GET(DRGI)
SET LCNT=LCNT+1
+19 SET ^XMB(3.9,XMZ,2,LCNT,0)=" Reason: "_REASON
SET LCNT=LCNT+1
+20 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
+21 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
+22 SET ^XMB(3.9,XMZ,2,LCNT,0)=" "
SET LCNT=LCNT+1
+23 KILL CMOPYN,FLL,FIL,BT,REASON,DRGI,DRGN,QY,I,SP,SPS,SP1
End DoDot:2
End DoDot:1
+24 SET ^XMB(3.9,XMZ,2,LCNT,0)="Instructions: Prescriptions cannot be processed at CMOP for the reason listed"
SET LCNT=LCNT+1
+25 SET ^XMB(3.9,XMZ,2,LCNT,0)="above. Please review the prescription and take the appropriate action(s)."
SET LCNT=LCNT+1
+26 SET ^XMB(3.9,XMZ,2,LCNT,0)="If you have any questions, contact your CMOP contact person."
SET LCNT=LCNT+1
+27 SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_"^"_LCNT_"^"_DT
SET XMDUN="CMOP Manager"
+28 KILL XMY
DO GRP
SET XMDUZ=.5
DO ENT1^XMD
+29 KILL XMY,XMDUZ,XMSUB,XMDUN,REASON,RXN,LCNT,XMZ,FILL,FIL,TDT,TDTM,BAT,DOMAIN,PTR,XPTR,FACDOM
+30 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
