PSXVND ;BIR/WPB,HTW,PWC-File Release Data at the Remote Facility ;10/29/98 2:13 PM
;;2.0;CMOP;**1,2,4,5,14,18,19,15,24,23,27,35,39,36,48,62,58,94**;11 Apr 97;Build 2
;Reference to ^PSDRUG( supported by DBIA #1983
;Reference to ^PSRX( supported by DBIA #1977
;Reference to ^PS(59 supported by DBIA #1976
;Reference to routine CP^PSOCP supported by DBIA #1974
;Reference to routine EN^PSOHLSN1 supported by DBIA #2385
;Reference to routine EN^RGEQ supported by DBIA #2382
;Reference to routine AUTOREL^PSOBPSUT supported by DBIA #4701
;Called by Taskman to handle release data
EN ; Entry point
N PSXGOTO
H 5 S CNT=1,FROM=XMFROM,ZTREQ="@"
S DOMAIN=$S($P(XMFROM,"@",2)'="":"@"_$P(FROM,"@",2),$P(XMFROM,"@",2)="":"",1:""),XMSER="S."_XQSOP,TXMZ=XQMSG
S (X,SITE,DA)=$$KSP^XUPARAM("INST"),DIC="4",DIQ(0)="IE",DR=99,DIQ="PSXUTIL"
D EN^DIQ1 S HERE=$G(PSXUTIL(4,SITE,99,"I")) K DA,DIC,DIQ(0),DR
;
; Looping through each Rx returned in the Mailman Message by CMOP
S PSXGOTO=""
F X XMREC Q:$G(XMRG)="" D I PSXGOTO'="" Q
. ;Protecting XMZ because it is used in the FOR Loop (inside XMREC above)
. N XMZ
. S TXMRG=XMRG
. I $G(XMER)<0 S PSXGOTO="EXIT1" Q
. I $E(XMRG,1,3)["$RX" D GET
. I $E(XMRG,1,5)["$$END" S PSXGOTO="MAIL" Q
. I $E(XMRG,1,4)["$LOT" D LOT
. S:$E(XMRG,1,5)["$$VND" MSNUM=$P(XMRG,"^",3)
I $G(PSXGOTO)'="" G @PSXGOTO
;
G EXIT
;
GET Q:$G(XMRG)=""!($E(XMRG,1,3)'["$RX")
K FACBAT,BAT,NDC,RELDT,STAT,REASON,XFILL,P515A,P515B,%,RR,ALOT,RXP,RXN,FLAG,FILL,RELD,ZSTAT,RTN,CARRIER,PKGID,SHPDT
S RX=$P(XMRG,U,2),FACBAT=$P(XMRG,U,3),BAT=$P(FACBAT,"-",2),NDC=$P(XMRG,U,4),RELDT=$P(XMRG,U,5),STAT=$P(XMRG,U,6),REASON=$P($G(XMRG),U,8),XFILL=$P($G(XMRG),U,7)
S P515A=$P(XMRG,U,9),P515B=$P(XMRG,U,10),DRG=$P(XMRG,U,12),QTY=$P(XMRG,U,11),CARRIER=$P(XMRG,U,13),PKGID=$P(XMRG,U,14),SHPDT=$P(XMRG,U,15)
S FAC=$P(FACBAT,"-",1)
Q:FAC'=HERE
I '$O(^PSRX("B",RX,0)) S FLAG=2 D TMP Q
S XX=0 F S XX=$O(^PSRX("B",RX,XX)) Q:XX'>0 S (RXP,RXN)=XX,FLAG=0 D
.I '$G(BAT) Q
.I '$D(^PSRX(RXN,0)) S FLAG=2 D TMP Q
.L +^PSRX(RXN):DTIME I '$T S FLAG=2 D TMP Q
.I XFILL>0,('$D(^PSRX(RXN,1,XFILL,0))) S FLAG=6 D TMP Q
.I XFILL>0,($P(^PSRX(RXP,1,XFILL,0),"^",18)'="") S FLAG=1,RLDT=$P(^PSRX(RXP,1,XFILL,0),"^",18) S:STAT=1&(RLDT=RELDT) FLAG=0 D:FLAG=0 TMP1 Q:'$G(FLAG) D:FLAG=1 TMP Q
.I XFILL=0,($P(^PSRX(RXP,2),"^",13)'="") S FLAG=1,RLDT=$P(^PSRX(RXP,2),"^",13) S:STAT=1&(RELDT=RLDT) FLAG=0 D:FLAG=0 TMP1 Q:'$G(FLAG) D:FLAG=1 TMP Q
.I STAT=2 D
..S RXDRG=$P(^PSRX(RXN,0),"^",6),DFN=$P(^PSRX(RXN,0),"^",2)
..I $G(RXDRG)]"" S CMOPNM=$P($G(^PSDRUG(RXDRG,0)),"^")
..I '$D(^PSDRUG("AQ",RXDRG)) S CMOPYN=1
..I $D(^PSDRUG(RXDRG,"ND")) S CMOPID=$P($G(^PSDRUG(RXDRG,"ND")),"^",10)
..S DIV=$S(XFILL=0:$P(^PSRX(RXN,2),U,9),XFILL>0:$P(^PSRX(RXN,1,XFILL,0),U,9),1:"")
..S ^TMP("PSXCAN1",$J,DIV,DFN,RX)=$G(CMOPNM)_U_$G(CMOPID)_U_$G(QTY)_U_$G(DRG)_U_$G(CMOPYN)_U_REASON_U_$G(XFILL)_U_$G(BAT)
..K CMOPNM,CMOPID,DRG,RXDRG,MATCH,CMOPYN,NDF1,NDF2,P1,P2,PSDDA
.I '$D(^PSRX(RXN,4,0)) S FLAG=5 D TMP Q
.I '$D(^PSRX(RXN,4,"B",BAT)) S FLAG=4 D TMP Q
.I $D(^PSRX(RXN,4,"B",BAT)) S RECD=$O(^PSRX(RXN,4,"B",BAT,"")),FILL=$P($G(^PSRX(RXN,4,RECD,0)),U,3),ZSTAT=$P(^PSRX(RXN,4,RECD,0),U,4)
.I ZSTAT=2 S RTN=0 F S RTN=$O(^PSRX(RXN,4,RTN)) Q:RTN'>0 I $P(^PSRX(RXN,4,RTN,0),U,3)=FILL&($P(^PSRX(RXN,4,RTN,0),U,1)'=BAT) S DA(1)=RXN,DA=RTN,DIE="^PSRX("_DA(1)_",4,",DR="3////2;8////FILLED IN TRANSMISSION "_BAT D ^DIE K DA,DR,DIE
.I FILL'=XFILL S FLAG=3 D TMP Q
.S PSXREF=FILL
.Q:FLAG>0
.D:$G(STAT)=1
..N PSOPAR,PSOSITE,X D NOW^%DTC
..I $G(PSXREF)>0 S PSOSITE=$P(^PSRX(RXP,1,PSXREF,0),"^",9) G:$G(PSOSITE) PAR
..S PSOSITE=$P(^PSRX(RXP,2),"^",9),PSQUIT=0
..I '$G(PSOSITE) S Z1=0 F S Z1=$O(^PS(59,Z1)) Q:Z1=""!(Z1="B") D Q:PSQUIT
...I $D(^PS(59,Z1,"I"))&($P($G(^PS(59,Z1,"I")),"^")'="") Q:$P($G(^PS(59,Z1,"I")),"^")'>X
...S PSOSITE=Z1,PSQUIT=1
..Q:'$G(PSOSITE)
PAR ..S PSOPAR=$G(^PS(59,PSOSITE,1))
..I $G(PSXREF)>0 S YY=PSXREF
..I '$G(PSOSITE)!('$D(PSOPAR)) Q
..D CP^PSOCP K YY,X
.I $G(FILL)="" Q
.I $G(STAT)=1 D
..I FILL=0 S DA=RXN,DIE="^PSRX(",DR="31///"_RELDT D ^DIE K DIE,DA,DR
..I FILL>0 S DA(1)=RXN,DA=FILL,DIE="^PSRX("_RXN_",1,",DR="17///"_RELDT_";10.1///"_RELDT D ^DIE K DIE,DR,DA
..; I $$VERSION^XPDUTL("OUTPATIENT PHARMACY")<7 S X="RGEQ" X ^%ZOSF("TEST") I D EN^RGEQ("RX",RXN) ;CIRN
..I $$VERSION^XPDUTL("OUTPATIENT PHARMACY")>6 D EN^PSOHLSN1(RXN,"ZD")
.S DA(1)=RXN,DA=RECD,DIE="^PSRX("_RXN_",4,"
.S DR="3////"_$S(STAT=2:3,STAT=1:1,1:"")_";4////"_NDC_";5////"_$S(STAT=2:RELDT,STAT=1:"",1:"")_";8////"_$S(STAT=2:"^S X=$G(REASON)",STAT=1:"",1:"")_";10////"_$G(CARRIER)_";11////"_$G(PKGID)_";9////"_$G(SHPDT)
.D ^DIE K DIE,DA,DR
.I $$PATCH^XPDUTL("PSO*7.0*148") D AUTOREL^PSOBPSUT(RXN,FILL,RELDT,NDC,"C",$S(STAT=1:"S",1:"U"),60)
I $D(^PSRX(RXN)) L -^PSRX(RXN):0
TMP1 Q:$G(FLAG)'=0!('$G(BAT))
D NOW^%DTC S PSXTM=%
S ^TMP($J,"PSXREL",CNT)=RX_"^"_PSXTM_"^"_P515A_"^"_P515B_"^"_XFILL_"^"_HERE
S CNT=CNT+1
Q
;
LOT S ALOT=$P(XMRG,"|",2)
I $G(ALOT)'="" D
.K DD,DO
.S:'$D(^PSRX(RXN,5,0)) ^PSRX(RXN,5,0)="^52.0401A^^"
.F RR=1:1 Q:$P(ALOT,"\",RR)="" S LOT1=$P(ALOT,"\",RR),LOT=$P(LOT1,"^",1),EXDT=$P(LOT1,"^",2) D
..S DA(1)=RXN,X=LOT,DIC="^PSRX("_RXN_",5,",DIC("DR")="1////"_EXDT_";2////"_XFILL,DIC(0)="Z"
FF ..D FILE^DICN K DIC("DR"),DIC,DA,LOT,EXDT,DD,DO
Q
TMP S ^TMP($J,"PSXVND",RX)=FLAG_"^"_XFILL_"^"_P515A_"^"_P515B_"^"_HERE_"^"_$S(FLAG=1:RLDT,1:"") Q
MAIL S XMSUB="CMOP Release Data Acknowledgement",LCNT=1,XMDUZ=.5
MM D XMZ^XMA2 G:XMZ<1 MM
S ^XMB(3.9,XMZ,2,LCNT,0)="$$RTN^"_MSNUM_"^"_HERE,LCNT=LCNT+1
F CC=0:0 S CC=$O(^TMP($J,"PSXREL",CC)) Q:CC'>0 D
.S ^XMB(3.9,XMZ,2,LCNT,0)="$RX^"_$G(^TMP($J,"PSXREL",CC)),LCNT=LCNT+1
S ^XMB(3.9,XMZ,2,LCNT,0)="$$INV"
S CC="" F S CC=$O(^TMP($J,"PSXVND",CC)) Q:CC="" S RXN=CC D
.S LCNT=LCNT+1 D NOW^%DTC S PSXTM=% ;added for PSX*2*36
.S ^XMB(3.9,XMZ,2,LCNT,0)="$RXN"_"^"_RXN_"^"_$G(^TMP($J,"PSXVND",CC))_"^"_PSXTM
S ^XMB(3.9,XMZ,2,LCNT+1,0)="$$ENDINV"
S ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_U_LCNT_U_DT,XMDUN="CMOP Manager"
K XMY S XMY("S.PSXX CMOP SERVER"_DOMAIN)="" D ENT1^XMD
;D ER6^PSXERR Q
D:$D(^TMP("PSXCAN1",$J)) CAN^PSXMSGS
EXIT S XMSER="S.PSXX CMOP SERVER",XMZ=TXMZ D REMSBMSG^XMA1C
EXIT1 K XMSUB,XMDUZ,XMDUN,XMY,LCNT,XMZ,CC,PSXREL,CNT,Y,X,RR,LOT,LOT1,EXDT,ALOT
K RXN,RX,DLAYGO,FACBAT,FILL,FROM,NDC,P514,REASON,RELDT,STAT,XMREC,XMRG
K ^TMP($J,"PSXVND"),^TMP($J,"PSXREL"),RLDT,FLAG,TXMRG,PSXXMZ,ZSTAT,PSXTM
K XQMSG,XQSOP,XX,ZZZ,%,DAT,DOMAIN,PSXJOB,PSXREF,RECD,RXP,TXMZ,XMZ,XMER
K XMFROM,XMSER,BAT,PSXREFL,XFILL,FAC,HERE,P515A,P515B,SITE,MSNUM
K DIQ,DIV,QTY,PSXUTIL,SHPDT,Z1,PSQUIT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXVND 6695 printed Oct 16, 2024@17:46:19 Page 2
PSXVND ;BIR/WPB,HTW,PWC-File Release Data at the Remote Facility ;10/29/98 2:13 PM
+1 ;;2.0;CMOP;**1,2,4,5,14,18,19,15,24,23,27,35,39,36,48,62,58,94**;11 Apr 97;Build 2
+2 ;Reference to ^PSDRUG( supported by DBIA #1983
+3 ;Reference to ^PSRX( supported by DBIA #1977
+4 ;Reference to ^PS(59 supported by DBIA #1976
+5 ;Reference to routine CP^PSOCP supported by DBIA #1974
+6 ;Reference to routine EN^PSOHLSN1 supported by DBIA #2385
+7 ;Reference to routine EN^RGEQ supported by DBIA #2382
+8 ;Reference to routine AUTOREL^PSOBPSUT supported by DBIA #4701
+9 ;Called by Taskman to handle release data
EN ; Entry point
+1 NEW PSXGOTO
+2 HANG 5
SET CNT=1
SET FROM=XMFROM
SET ZTREQ="@"
+3 SET DOMAIN=$SELECT($PIECE(XMFROM,"@",2)'="":"@"_$PIECE(FROM,"@",2),$PIECE(XMFROM,"@",2)="":"",1:"")
SET XMSER="S."_XQSOP
SET TXMZ=XQMSG
+4 SET (X,SITE,DA)=$$KSP^XUPARAM("INST")
SET DIC="4"
SET DIQ(0)="IE"
SET DR=99
SET DIQ="PSXUTIL"
+5 DO EN^DIQ1
SET HERE=$GET(PSXUTIL(4,SITE,99,"I"))
KILL DA,DIC,DIQ(0),DR
+6 ;
+7 ; Looping through each Rx returned in the Mailman Message by CMOP
+8 SET PSXGOTO=""
+9 FOR
XECUTE XMREC
if $GET(XMRG)=""
QUIT
Begin DoDot:1
+10 ;Protecting XMZ because it is used in the FOR Loop (inside XMREC above)
+11 NEW XMZ
+12 SET TXMRG=XMRG
+13 IF $GET(XMER)<0
SET PSXGOTO="EXIT1"
QUIT
+14 IF $EXTRACT(XMRG,1,3)["$RX"
DO GET
+15 IF $EXTRACT(XMRG,1,5)["$$END"
SET PSXGOTO="MAIL"
QUIT
+16 IF $EXTRACT(XMRG,1,4)["$LOT"
DO LOT
+17 if $EXTRACT(XMRG,1,5)["$$VND"
SET MSNUM=$PIECE(XMRG,"^",3)
End DoDot:1
IF PSXGOTO'=""
QUIT
+18 IF $GET(PSXGOTO)'=""
GOTO @PSXGOTO
+19 ;
+20 GOTO EXIT
+21 ;
GET if $GET(XMRG)=""!($EXTRACT(XMRG,1,3)'["$RX")
QUIT
+1 KILL FACBAT,BAT,NDC,RELDT,STAT,REASON,XFILL,P515A,P515B,%,RR,ALOT,RXP,RXN,FLAG,FILL,RELD,ZSTAT,RTN,CARRIER,PKGID,SHPDT
+2 SET RX=$PIECE(XMRG,U,2)
SET FACBAT=$PIECE(XMRG,U,3)
SET BAT=$PIECE(FACBAT,"-",2)
SET NDC=$PIECE(XMRG,U,4)
SET RELDT=$PIECE(XMRG,U,5)
SET STAT=$PIECE(XMRG,U,6)
SET REASON=$PIECE($GET(XMRG),U,8)
SET XFILL=$PIECE($GET(XMRG),U,7)
+3 SET P515A=$PIECE(XMRG,U,9)
SET P515B=$PIECE(XMRG,U,10)
SET DRG=$PIECE(XMRG,U,12)
SET QTY=$PIECE(XMRG,U,11)
SET CARRIER=$PIECE(XMRG,U,13)
SET PKGID=$PIECE(XMRG,U,14)
SET SHPDT=$PIECE(XMRG,U,15)
+4 SET FAC=$PIECE(FACBAT,"-",1)
+5 if FAC'=HERE
QUIT
+6 IF '$ORDER(^PSRX("B",RX,0))
SET FLAG=2
DO TMP
QUIT
+7 SET XX=0
FOR
SET XX=$ORDER(^PSRX("B",RX,XX))
if XX'>0
QUIT
SET (RXP,RXN)=XX
SET FLAG=0
Begin DoDot:1
+8 IF '$GET(BAT)
QUIT
+9 IF '$DATA(^PSRX(RXN,0))
SET FLAG=2
DO TMP
QUIT
+10 LOCK +^PSRX(RXN):DTIME
IF '$TEST
SET FLAG=2
DO TMP
QUIT
+11 IF XFILL>0
IF ('$DATA(^PSRX(RXN,1,XFILL,0)))
SET FLAG=6
DO TMP
QUIT
+12 IF XFILL>0
IF ($PIECE(^PSRX(RXP,1,XFILL,0),"^",18)'="")
SET FLAG=1
SET RLDT=$PIECE(^PSRX(RXP,1,XFILL,0),"^",18)
if STAT=1&(RLDT=RELDT)
SET FLAG=0
if FLAG=0
DO TMP1
if '$GET(FLAG)
QUIT
if FLAG=1
DO TMP
QUIT
+13 IF XFILL=0
IF ($PIECE(^PSRX(RXP,2),"^",13)'="")
SET FLAG=1
SET RLDT=$PIECE(^PSRX(RXP,2),"^",13)
if STAT=1&(RELDT=RLDT)
SET FLAG=0
if FLAG=0
DO TMP1
if '$GET(FLAG)
QUIT
if FLAG=1
DO TMP
QUIT
+14 IF STAT=2
Begin DoDot:2
+15 SET RXDRG=$PIECE(^PSRX(RXN,0),"^",6)
SET DFN=$PIECE(^PSRX(RXN,0),"^",2)
+16 IF $GET(RXDRG)]""
SET CMOPNM=$PIECE($GET(^PSDRUG(RXDRG,0)),"^")
+17 IF '$DATA(^PSDRUG("AQ",RXDRG))
SET CMOPYN=1
+18 IF $DATA(^PSDRUG(RXDRG,"ND"))
SET CMOPID=$PIECE($GET(^PSDRUG(RXDRG,"ND")),"^",10)
+19 SET DIV=$SELECT(XFILL=0:$PIECE(^PSRX(RXN,2),U,9),XFILL>0:$PIECE(^PSRX(RXN,1,XFILL,0),U,9),1:"")
+20 SET ^TMP("PSXCAN1",$JOB,DIV,DFN,RX)=$GET(CMOPNM)_U_$GET(CMOPID)_U_$GET(QTY)_U_$GET(DRG)_U_$GET(CMOPYN)_U_REASON_U_$GET(XFILL)_U_$GET(BAT)
+21 KILL CMOPNM,CMOPID,DRG,RXDRG,MATCH,CMOPYN,NDF1,NDF2,P1,P2,PSDDA
End DoDot:2
+22 IF '$DATA(^PSRX(RXN,4,0))
SET FLAG=5
DO TMP
QUIT
+23 IF '$DATA(^PSRX(RXN,4,"B",BAT))
SET FLAG=4
DO TMP
QUIT
+24 IF $DATA(^PSRX(RXN,4,"B",BAT))
SET RECD=$ORDER(^PSRX(RXN,4,"B",BAT,""))
SET FILL=$PIECE($GET(^PSRX(RXN,4,RECD,0)),U,3)
SET ZSTAT=$PIECE(^PSRX(RXN,4,RECD,0),U,4)
+25 IF ZSTAT=2
SET RTN=0
FOR
SET RTN=$ORDER(^PSRX(RXN,4,RTN))
if RTN'>0
QUIT
IF $PIECE(^PSRX(RXN,4,RTN,0),U,3)=FILL&($PIECE(^PSRX(RXN,4,RTN,0),U,1)'=BAT)
SET DA(1)=RXN
SET DA=RTN
SET DIE="^PSRX("_DA(1)_",4,"
SET DR="3////2;8////FILLED IN TRANSMISSION "_BAT
DO ^DIE
KILL DA,DR,DIE
+26 IF FILL'=XFILL
SET FLAG=3
DO TMP
QUIT
+27 SET PSXREF=FILL
+28 if FLAG>0
QUIT
+29 if $GET(STAT)=1
Begin DoDot:2
+30 NEW PSOPAR,PSOSITE,X
DO NOW^%DTC
+31 IF $GET(PSXREF)>0
SET PSOSITE=$PIECE(^PSRX(RXP,1,PSXREF,0),"^",9)
if $GET(PSOSITE)
GOTO PAR
+32 SET PSOSITE=$PIECE(^PSRX(RXP,2),"^",9)
SET PSQUIT=0
+33 IF '$GET(PSOSITE)
SET Z1=0
FOR
SET Z1=$ORDER(^PS(59,Z1))
if Z1=""!(Z1="B")
QUIT
Begin DoDot:3
+34 IF $DATA(^PS(59,Z1,"I"))&($PIECE($GET(^PS(59,Z1,"I")),"^")'="")
if $PIECE($GET(^PS(59,Z1,"I")),"^")'>X
QUIT
+35 SET PSOSITE=Z1
SET PSQUIT=1
End DoDot:3
if PSQUIT
QUIT
+36 if '$GET(PSOSITE)
QUIT
PAR SET PSOPAR=$GET(^PS(59,PSOSITE,1))
+1 IF $GET(PSXREF)>0
SET YY=PSXREF
+2 IF '$GET(PSOSITE)!('$DATA(PSOPAR))
QUIT
+3 DO CP^PSOCP
KILL YY,X
End DoDot:2
+4 IF $GET(FILL)=""
QUIT
+5 IF $GET(STAT)=1
Begin DoDot:2
+6 IF FILL=0
SET DA=RXN
SET DIE="^PSRX("
SET DR="31///"_RELDT
DO ^DIE
KILL DIE,DA,DR
+7 IF FILL>0
SET DA(1)=RXN
SET DA=FILL
SET DIE="^PSRX("_RXN_",1,"
SET DR="17///"_RELDT_";10.1///"_RELDT
DO ^DIE
KILL DIE,DR,DA
+8 ; I $$VERSION^XPDUTL("OUTPATIENT PHARMACY")<7 S X="RGEQ" X ^%ZOSF("TEST") I D EN^RGEQ("RX",RXN) ;CIRN
+9 IF $$VERSION^XPDUTL("OUTPATIENT PHARMACY")>6
DO EN^PSOHLSN1(RXN,"ZD")
End DoDot:2
+10 SET DA(1)=RXN
SET DA=RECD
SET DIE="^PSRX("_RXN_",4,"
+11 SET DR="3////"_$SELECT(STAT=2:3,STAT=1:1,1:"")_";4////"_NDC_";5////"_$SELECT(STAT=2:RELDT,STAT=1:"",1:"")_";8////"_$SELECT(STAT=2:"^S X=$G(REASON)",STAT=1:"",1:"")_";10////"_$GET(CARRIER)_";11////"_$GET(PKGID)_";9////"_$GET(SHPDT)
+12 DO ^DIE
KILL DIE,DA,DR
+13 IF $$PATCH^XPDUTL("PSO*7.0*148")
DO AUTOREL^PSOBPSUT(RXN,FILL,RELDT,NDC,"C",$SELECT(STAT=1:"S",1:"U"),60)
End DoDot:1
+14 IF $DATA(^PSRX(RXN))
LOCK -^PSRX(RXN):0
TMP1 if $GET(FLAG)'=0!('$GET(BAT))
QUIT
+1 DO NOW^%DTC
SET PSXTM=%
+2 SET ^TMP($JOB,"PSXREL",CNT)=RX_"^"_PSXTM_"^"_P515A_"^"_P515B_"^"_XFILL_"^"_HERE
+3 SET CNT=CNT+1
+4 QUIT
+5 ;
LOT SET ALOT=$PIECE(XMRG,"|",2)
+1 IF $GET(ALOT)'=""
Begin DoDot:1
+2 KILL DD,DO
+3 if '$DATA(^PSRX(RXN,5,0))
SET ^PSRX(RXN,5,0)="^52.0401A^^"
+4 FOR RR=1:1
if $PIECE(ALOT,"\",RR)=""
QUIT
SET LOT1=$PIECE(ALOT,"\",RR)
SET LOT=$PIECE(LOT1,"^",1)
SET EXDT=$PIECE(LOT1,"^",2)
Begin DoDot:2
+5 SET DA(1)=RXN
SET X=LOT
SET DIC="^PSRX("_RXN_",5,"
SET DIC("DR")="1////"_EXDT_";2////"_XFILL
SET DIC(0)="Z"
FF DO FILE^DICN
KILL DIC("DR"),DIC,DA,LOT,EXDT,DD,DO
End DoDot:2
End DoDot:1
+1 QUIT
TMP SET ^TMP($JOB,"PSXVND",RX)=FLAG_"^"_XFILL_"^"_P515A_"^"_P515B_"^"_HERE_"^"_$SELECT(FLAG=1:RLDT,1:"")
QUIT
MAIL SET XMSUB="CMOP Release Data Acknowledgement"
SET LCNT=1
SET XMDUZ=.5
MM DO XMZ^XMA2
if XMZ<1
GOTO MM
+1 SET ^XMB(3.9,XMZ,2,LCNT,0)="$$RTN^"_MSNUM_"^"_HERE
SET LCNT=LCNT+1
+2 FOR CC=0:0
SET CC=$ORDER(^TMP($JOB,"PSXREL",CC))
if CC'>0
QUIT
Begin DoDot:1
+3 SET ^XMB(3.9,XMZ,2,LCNT,0)="$RX^"_$GET(^TMP($JOB,"PSXREL",CC))
SET LCNT=LCNT+1
End DoDot:1
+4 SET ^XMB(3.9,XMZ,2,LCNT,0)="$$INV"
+5 SET CC=""
FOR
SET CC=$ORDER(^TMP($JOB,"PSXVND",CC))
if CC=""
QUIT
SET RXN=CC
Begin DoDot:1
+6 ;added for PSX*2*36
SET LCNT=LCNT+1
DO NOW^%DTC
SET PSXTM=%
+7 SET ^XMB(3.9,XMZ,2,LCNT,0)="$RXN"_"^"_RXN_"^"_$GET(^TMP($JOB,"PSXVND",CC))_"^"_PSXTM
End DoDot:1
+8 SET ^XMB(3.9,XMZ,2,LCNT+1,0)="$$ENDINV"
+9 SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_U_LCNT_U_DT
SET XMDUN="CMOP Manager"
+10 KILL XMY
SET XMY("S.PSXX CMOP SERVER"_DOMAIN)=""
DO ENT1^XMD
+11 ;D ER6^PSXERR Q
+12 if $DATA(^TMP("PSXCAN1",$JOB))
DO CAN^PSXMSGS
EXIT SET XMSER="S.PSXX CMOP SERVER"
SET XMZ=TXMZ
DO REMSBMSG^XMA1C
EXIT1 KILL XMSUB,XMDUZ,XMDUN,XMY,LCNT,XMZ,CC,PSXREL,CNT,Y,X,RR,LOT,LOT1,EXDT,ALOT
+1 KILL RXN,RX,DLAYGO,FACBAT,FILL,FROM,NDC,P514,REASON,RELDT,STAT,XMREC,XMRG
+2 KILL ^TMP($JOB,"PSXVND"),^TMP($JOB,"PSXREL"),RLDT,FLAG,TXMRG,PSXXMZ,ZSTAT,PSXTM
+3 KILL XQMSG,XQSOP,XX,ZZZ,%,DAT,DOMAIN,PSXJOB,PSXREF,RECD,RXP,TXMZ,XMZ,XMER
+4 KILL XMFROM,XMSER,BAT,PSXREFL,XFILL,FAC,HERE,P515A,P515B,SITE,MSNUM
+5 KILL DIQ,DIV,QTY,PSXUTIL,SHPDT,Z1,PSQUIT
+6 QUIT
