PSXRTRA1.m

PSXRTRA1 ;BIR/PDW-RETRANSMISSION REPORT SUBROUTINE ;11 AUG 2002

 ;;2.0;CMOP;**41,51**;11 Apr 97

 ;Reference to ^PSRX(   supported by DBIA #1977

REPORT ;

 K ^TMP($J,"PSXRTRPT"),LSSN S CNT=21

 S PTNM="" F  S PTNM=$O(^PSX(550.2,OLDBAT,15,"C",PTNM)) Q:PTNM=""  D

 . S DFN=0 F  S LSSN="" S DFN=$O(^PSX(550.2,OLDBAT,15,"C",PTNM,DFN)) Q:DFN'>0  D RXS

 D MM

 K PTNM,RXPTR,XSTAT

 Q

RXS ;

 S RXPTR=0 F  S RXPTR=$O(^PSX(550.2,OLDBAT,15,"C",PTNM,DFN,RXPTR)) Q:RXPTR=""  D

 . S FILL=$O(^PSX(550.2,OLDBAT,15,"C",PTNM,DFN,RXPTR,""))

 . D TXT

 Q

MM S XMSUB="CMOP Retransmission Report for "_$G(OLDBATNM),XMDUZ=.5,XMDUN="CMOP Managers"

 D XMZ^XMA2 G:$G(XMZ)'>0 MM

 S ^XMB(3.9,XMZ,2,1,0)="CMOP Re-Transmission Report"

 S ^XMB(3.9,XMZ,2,2,0)=$G(PSXBATNM)_" Re-Transmission of "_$G(OLDBATNM)

 S ^XMB(3.9,XMZ,2,3,0)=" "

 S ^XMB(3.9,XMZ,2,4,0)="The Original Transmission # "_$G(OLDBATNM)_" contained:"

 S ^XMB(3.9,XMZ,2,5,0)="Beginning Message Number: "_$P(^PSX(550.2,OLDBAT,1),"^",5)

 S ^XMB(3.9,XMZ,2,6,0)="Ending Message Number   : "_$P(^PSX(550.2,OLDBAT,1),"^",6)

 S ^XMB(3.9,XMZ,2,7,0)="Total Orders            : "_$P(^PSX(550.2,OLDBAT,1),"^",7)

 S ^XMB(3.9,XMZ,2,8,0)="Total Rx's              : "_$P(^PSX(550.2,OLDBAT,1),"^",8)

 S ^XMB(3.9,XMZ,2,9,0)=" "

 S ^XMB(3.9,XMZ,2,10,0)="Retransmission # "_$G(PSXBATNM)_" contained:"

 S ^XMB(3.9,XMZ,2,11,0)="Beginning Message Number: "_$G(MCT)

 S ^XMB(3.9,XMZ,2,12,0)="Ending Message Number   : "_$G(LMSG)

 S ^XMB(3.9,XMZ,2,13,0)="Total Orders            : "_$G(PSXMSGCT)

 S ^XMB(3.9,XMZ,2,14,0)="Total Rx's              : "_$G(PSXRXCT)

 S ^XMB(3.9,XMZ,2,15,0)=" "

 S ^XMB(3.9,XMZ,2,16,0)="Following is a list of the original prescription orders and their status."

 S ^XMB(3.9,XMZ,2,17,0)="** Prescriptions that have been refilled or released are not sent. **"

 I '$D(^TMP($J,"PSXRTRPT")) S ^XMB(3.9,XMZ,17,0)="All prescriptions were transmitted" S CNT=17 G MAIL

 F JJ=18,19,20 S ^XMB(3.9,XMZ,2,JJ,0)=" "

 S XX="Patient",Y="SSN",XX=$$SETSTR^VALM1("SSN",XX,25,3)

 S XX=$$SETSTR^VALM1("RX",XX,40,2),XX=$$SETSTR^VALM1("RELEASE DATE | FILL'=",XX,55,21)

 S ^XMB(3.9,XMZ,2,21,0)=XX

 M ^XMB(3.9,XMZ,2)=^TMP($J,"PSXRTRPT","MM")

MAIL ;

 S ^XMB(3.9,XMZ,2,0)="^3.92A^"_CNT_"^"_CNT_"^"_DT

 K XMY

 S XMY(DUZ)="" ;****TESTING

 D GRP^PSXNOTE ;****TESTING

 D ENT1^XMD

 Q

TXT ; store PAT & RX info for mail message

 D DEM^VADPT S SSN=$P(VADM(2),U,2),PATNM=VADM(1)

 S RXNM=$P(^PSRX(RXPTR,0),U)_"-"_FILL

 S XSTAT=""

 I '$D(^PSX(550.2,PSXBAT,15,"B",RXPTR)) D

 .S XSTAT=$$TESTREL^PSXRTRAN(RXPTR,FILL)

 .S:XSTAT="SENT" XSTAT="OTHER"

 S XX=""

 I $G(LSSN)'=SSN D

 . S XX=$E(PATNM,1,23)

 . S XX=$$SETSTR^VALM1(SSN,XX,25,$L(SSN))

 S XX=$$SETSTR^VALM1(RXNM,XX,40,$L(RXNM))

 S:$L(XSTAT) XX=$$SETSTR^VALM1(XSTAT,XX,60,$L(XSTAT))

 S CNT=$G(CNT)+1,LSSN=SSN

 S ^TMP($J,"PSXRTRPT","MM",CNT,0)=XX

 Q

CANMSG ; lock on 550.1 not achieved send transmission cancelled message

 S PSXCS=+$G(PSXCS)

 S XMSUB=$S($G(PSXCS):"",1:"NON-")_"CS Retransmission Cancelled"

 S XMTEXT="TXT("

 S TXT(1,0)="The "_$S($G(PSXCS):"",1:"NON-")_"CS Manual Transmission was cancelled "_$$GET1^DIQ(550.2,OLDBAT,.01)

 S TXT(2,0)="It could not obtain a lock on the RX QUEUE file. #550.1"

 S TXT(3,0)="This indicates that a transmission was in progress."

 S TXT(6,0)=" "

 S TXT(7,0)="If you are getting this message frequently, please contact your IRM Group"

 D EN^PSXNOTE ;****TESTING

 D ^XMD

 Q

SETSTAT ;Set RX CMOP status to re-transmitted

 N RXDA,CMPDA

 S RXDA=0 F  S RXDA=$O(^PSX(550.2,PSXBAT,15,"B",RXDA)) Q:RXDA'>0  D

 . S CMPDA=$O(^PSRX(RXDA,4,"B",OLDBAT,0)) Q:'CMPDA

 . Q:'CMPDA  Q:'$D(^PSRX(RXDA,4,CMPDA,0))

 . S $P(^PSRX(RXDA,4,CMPDA,0),U,4)=2

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSXRTRA1   3702     printed  Mar 13, 2025@20:49:45                                                                                                                                                                                                    Page 2

PSXRTRA1  ;BIR/PDW-RETRANSMISSION REPORT SUBROUTINE ;11 AUG 2002

 +1       ;;2.0;CMOP;**41,51**;11 Apr 97

 +2       ;Reference to ^PSRX(   supported by DBIA #1977

REPORT    ;

 +1        KILL ^TMP($JOB,"PSXRTRPT"),LSSN

           SET CNT=21

 +2        SET PTNM=""

           FOR 

               SET PTNM=$ORDER(^PSX(550.2,OLDBAT,15,"C",PTNM))

               if PTNM=""

                   QUIT 

               Begin DoDot:1

 +3                SET DFN=0

                   FOR 

                       SET LSSN=""

                       SET DFN=$ORDER(^PSX(550.2,OLDBAT,15,"C",PTNM,DFN))

                       if DFN'>0

                           QUIT 

                       DO RXS

               End DoDot:1

 +4        DO MM

 +5        KILL PTNM,RXPTR,XSTAT

 +6        QUIT 

RXS       ;

 +1        SET RXPTR=0

           FOR 

               SET RXPTR=$ORDER(^PSX(550.2,OLDBAT,15,"C",PTNM,DFN,RXPTR))

               if RXPTR=""

                   QUIT 

               Begin DoDot:1

 +2                SET FILL=$ORDER(^PSX(550.2,OLDBAT,15,"C",PTNM,DFN,RXPTR,""))

 +3                DO TXT

               End DoDot:1

 +4        QUIT 

MM         SET XMSUB="CMOP Retransmission Report for "_$GET(OLDBATNM)

           SET XMDUZ=.5

           SET XMDUN="CMOP Managers"

 +1        DO XMZ^XMA2

           if $GET(XMZ)'>0

               GOTO MM

 +2        SET ^XMB(3.9,XMZ,2,1,0)="CMOP Re-Transmission Report"

 +3        SET ^XMB(3.9,XMZ,2,2,0)=$GET(PSXBATNM)_" Re-Transmission of "_$GET(OLDBATNM)

 +4        SET ^XMB(3.9,XMZ,2,3,0)=" "

 +5        SET ^XMB(3.9,XMZ,2,4,0)="The Original Transmission # "_$GET(OLDBATNM)_" contained:"

 +6        SET ^XMB(3.9,XMZ,2,5,0)="Beginning Message Number: "_$PIECE(^PSX(550.2,OLDBAT,1),"^",5)

 +7        SET ^XMB(3.9,XMZ,2,6,0)="Ending Message Number   : "_$PIECE(^PSX(550.2,OLDBAT,1),"^",6)

 +8        SET ^XMB(3.9,XMZ,2,7,0)="Total Orders            : "_$PIECE(^PSX(550.2,OLDBAT,1),"^",7)

 +9        SET ^XMB(3.9,XMZ,2,8,0)="Total Rx's              : "_$PIECE(^PSX(550.2,OLDBAT,1),"^",8)

 +10       SET ^XMB(3.9,XMZ,2,9,0)=" "

 +11       SET ^XMB(3.9,XMZ,2,10,0)="Retransmission # "_$GET(PSXBATNM)_" contained:"

 +12       SET ^XMB(3.9,XMZ,2,11,0)="Beginning Message Number: "_$GET(MCT)

 +13       SET ^XMB(3.9,XMZ,2,12,0)="Ending Message Number   : "_$GET(LMSG)

 +14       SET ^XMB(3.9,XMZ,2,13,0)="Total Orders            : "_$GET(PSXMSGCT)

 +15       SET ^XMB(3.9,XMZ,2,14,0)="Total Rx's              : "_$GET(PSXRXCT)

 +16       SET ^XMB(3.9,XMZ,2,15,0)=" "

 +17       SET ^XMB(3.9,XMZ,2,16,0)="Following is a list of the original prescription orders and their status."

 +18       SET ^XMB(3.9,XMZ,2,17,0)="** Prescriptions that have been refilled or released are not sent. **"

 +19       IF '$DATA(^TMP($JOB,"PSXRTRPT"))

               SET ^XMB(3.9,XMZ,17,0)="All prescriptions were transmitted"

               SET CNT=17

               GOTO MAIL

 +20       FOR JJ=18,19,20

               SET ^XMB(3.9,XMZ,2,JJ,0)=" "

 +21       SET XX="Patient"

           SET Y="SSN"

           SET XX=$$SETSTR^VALM1("SSN",XX,25,3)

 +22       SET XX=$$SETSTR^VALM1("RX",XX,40,2)

           SET XX=$$SETSTR^VALM1("RELEASE DATE | FILL'=",XX,55,21)

 +23       SET ^XMB(3.9,XMZ,2,21,0)=XX

 +24       MERGE ^XMB(3.9,XMZ,2)=^TMP($JOB,"PSXRTRPT","MM")

MAIL      ;

 +1        SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_CNT_"^"_CNT_"^"_DT

 +2        KILL XMY

 +3       ;****TESTING

           SET XMY(DUZ)=""

 +4       ;****TESTING

           DO GRP^PSXNOTE

 +5        DO ENT1^XMD

 +6        QUIT 

TXT       ; store PAT & RX info for mail message

 +1        DO DEM^VADPT

           SET SSN=$PIECE(VADM(2),U,2)

           SET PATNM=VADM(1)

 +2        SET RXNM=$PIECE(^PSRX(RXPTR,0),U)_"-"_FILL

 +3        SET XSTAT=""

 +4        IF '$DATA(^PSX(550.2,PSXBAT,15,"B",RXPTR))

               Begin DoDot:1

 +5                SET XSTAT=$$TESTREL^PSXRTRAN(RXPTR,FILL)

 +6                if XSTAT="SENT"

                       SET XSTAT="OTHER"

               End DoDot:1

 +7        SET XX=""

 +8        IF $GET(LSSN)'=SSN

               Begin DoDot:1

 +9                SET XX=$EXTRACT(PATNM,1,23)

 +10               SET XX=$$SETSTR^VALM1(SSN,XX,25,$LENGTH(SSN))

               End DoDot:1

 +11       SET XX=$$SETSTR^VALM1(RXNM,XX,40,$LENGTH(RXNM))

 +12       if $LENGTH(XSTAT)

               SET XX=$$SETSTR^VALM1(XSTAT,XX,60,$LENGTH(XSTAT))

 +13       SET CNT=$GET(CNT)+1

           SET LSSN=SSN

 +14       SET ^TMP($JOB,"PSXRTRPT","MM",CNT,0)=XX

 +15       QUIT 

CANMSG    ; lock on 550.1 not achieved send transmission cancelled message

 +1        SET PSXCS=+$GET(PSXCS)

 +2        SET XMSUB=$SELECT($GET(PSXCS):"",1:"NON-")_"CS Retransmission Cancelled"

 +3        SET XMTEXT="TXT("

 +4        SET TXT(1,0)="The "_$SELECT($GET(PSXCS):"",1:"NON-")_"CS Manual Transmission was cancelled "_$$GET1^DIQ(550.2,OLDBAT,.01)

 +5        SET TXT(2,0)="It could not obtain a lock on the RX QUEUE file. #550.1"

 +6        SET TXT(3,0)="This indicates that a transmission was in progress."

 +7        SET TXT(6,0)=" "

 +8        SET TXT(7,0)="If you are getting this message frequently, please contact your IRM Group"

 +9       ;****TESTING

           DO EN^PSXNOTE

 +10       DO ^XMD

 +11       QUIT 

SETSTAT   ;Set RX CMOP status to re-transmitted

 +1        NEW RXDA,CMPDA

 +2        SET RXDA=0

           FOR 

               SET RXDA=$ORDER(^PSX(550.2,PSXBAT,15,"B",RXDA))

               if RXDA'>0

                   QUIT 

               Begin DoDot:1

 +3                SET CMPDA=$ORDER(^PSRX(RXDA,4,"B",OLDBAT,0))

                   if 'CMPDA

                       QUIT 

 +4                if 'CMPDA

                       QUIT 

                   if '$DATA(^PSRX(RXDA,4,CMPDA,0))

                       QUIT 

 +5                SET $PIECE(^PSRX(RXDA,4,CMPDA,0),U,4)=2

               End DoDot:1

 +6        QUIT