Routine: PSXMSGS

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

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

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

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

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

GRP1 F XDUZ=0:0 S XDUZ=$O(^XUSEC("PSXCMOPMGR",XDUZ)) Q:XDUZ'>0  S XMY(XDUZ)="",XQA(XDUZ)=""

 K XDUZ

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

PSXMSGS.m