- 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
- 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
