PSXRTN1 ;BIR/WPB,HTW-Background filer for V2 ;MAR 1,2002@16:11:17
 ;;2.0;CMOP;**1,2,14,23,32**;11 Apr 97
 ;Reference to ^PSDRUG( supported by DBIA #1983
DATA ;gets the data from PSX(513
 S PSXZTSK=ZTSK
 S R554=$O(^PSX(554,"AB",""))
 I $P($G(^PSX(554,1,1,R554,0)),U,4)="R" D NEXT^PSXRTN Q
 S $P(^PSX(554,1,1,R554,0),U,4)="R"
EN K ^TMP($J,"PSXCAN"),XX0,ZZ,REC,TNODE
 S X=$$FMADD^XLFDT(DT,+7),^XTMP("PSXBAD "_DT,0)=X_U_DT_U_"Vendor Missing NTE|100 segments"
 S (CANFLG,STOP,ZMPFLG)=0
 S LSTQRY=$O(^PSX(553.2,"A"),-1)
 S XX0=0 F  S XX0=$O(^PSX(552.3,"AQ",XX0)) Q:XX0'>0  G:STOP>0 FIN S TNODE=$G(^PSX(552.3,XX0,0)) S XX1=XX0+1 D
 .I $E(TNODE,1,7)["NTE|100" S DA=XX0,DR="1////1",DIE="^PSX(552.3," D ^DIE K DIE,DA,DR Q
 .I $E(TNODE,1,4)["PID|" S DA=XX0,DIE="^PSX(552.3,",DR="1////1" D ^DIE K DA,DR,DIE Q
 .I $E(TNODE,1,4)["MSA|" S QRYN=$P(TNODE,"|",3),DA=XX0,DR="1////1",DIE="^PSX(552.3," D ^DIE K DA,DIE,DR D  Q
 ..I $G(QRYN)>0 S:($G(QRYN)=LSTQRY)&($P(^PSX(553.1,QRYN,0),"^",5)'=1) STOP=1
 .Q:$G(STOP)>0
 .S:$G(QRYN)'>0 QRYN=LSTQRY-1
 .I $E(TNODE,1,3)["BTS" S DA=XX0,DR="1////1",DIE="^PSX(552.3," D ^DIE K DA,DR,DIE,QRYD Q
 .I $E(TNODE,1,4)["QRD|" S PSXTS=$P(TNODE,"|",2),QRYN=$P(TNODE,"|",5) D TSIN^PSXUTL L +^PSX(553.1,QRYN):30 S QRYD=XX0,DA=QRYN,DIE="^PSX(553.1,",DR="2////"_PSXFM D ^DIE K DA,DR,DIE,PSXTS,PSXFM L -^PSX(553.1,QRYN) D  Q
 ..S DA=XX0,DIE="^PSX(552.3,",DR="1////1" D ^DIE K DA,DIE,DR
 .I $E(TNODE,1,4)["ZMP|" D ZMP S ZMPFLG=1 Q
 .I $E(TNODE,1,4)["MSH|" S DA=XX0,DR="1////1",DIE="^PSX(552.3," D ^DIE K DA,DR,DIE D  Q
 .I $E(TNODE,1,8)["NTE|99||" D
 ..;S DA=XX0,DIE="^PSX(552.3,",DR="1////1" D ^DIE K DA,DR,DIE
 ..S STAT=$P(TNODE,"\",3),RXN=$P($P(TNODE,"\",1),"|",4),FACBAT=$P($P(TNODE,"\F\",6),"-",1,2)
 ..S PSXTS=$P(TNODE,"\",5) D TSIN^PSXUTL S COMDT=PSXFM
 ..S EMPID=$P(TNODE,"\",9),RXSTAT=1
 ..S PSXNDC=$P(TNODE,"\",7)
 ..S NPTR=$P($P(TNODE,"\",11),"-",1,2)
 ..K XX2 S:$G(^PSX(552.3,XX1,0))["NTE|100" XX2=XX1 ;flag for NTE|100 present
 ..I STAT="CA" D
 ...I '$G(XX2) S ^XTMP("PSXBAD "_DT,XX1)=$G(TNODE) Q
 ...S STAT=2,CANFLG=1,REASON=$P($P(^PSX(552.3,XX1,0),"\F",1),"|",4)
 ..I STAT="CO" S STAT=1 D
 ...I '$G(XX2) S ^XTMP("PSXBAD "_DT,XX1)=$G(TNODE) Q
 ...S SHPDT=$P(^PSX(552.3,XX1,0),"\F\",2),CARRIER=$P(^PSX(552.3,XX1,0),"\F\",3),PKID=$P(^PSX(552.3,XX1,0),"\F\",4) S:$G(CARRIER)="" CARRIER="UNK"
 ...I $G(SHPDT) S SHPDT=$$HL7TFM^XLFDT(SHPDT)
 ..K PSXLOT S CC=0 F BB=13:4 Q:$P(TNODE,"\",BB)=""  S CC=CC+1,PSXLOT(CC)=$P(TNODE,"\",BB)_"^"_$P(TNODE,"\",BB+2)
 ..D FILE S DA=XX0,DIE="^PSX(552.3,",DR="1////1" D ^DIE K DA I $G(XX2) S DA=XX2 D ^DIE K DA,DR,XX2,DIE
 ..K COMDT,STAT,REASON,PSXNDC,EMPID,COST,RXSTAT,BB,RXN,TDT,XDA,NPTR
 ..K PSXLOT,STAT1,STAT2,ZMPFLG,SHPDT,CARRIER,PKID,XX2
 I '$O(^XTMP("PSXBAD "_DT,0)) K ^XTMP("PSXBAD "_DT,0)
FIN D EN^PSXVEND
 D:CANFLG>0 CAN^PSXMSGS
 S $P(^PSX(554,1,1,R554,0),U,4)="S"
 D NDRGMSG^PSXRTN,NEXT^PSXRTN
 I $G(^TMP($J,"PSXDUP"))'="" S XQAMSG="Duplicate release data received from the vendor system.",XQAROU="ALRT^PSXDRPT",XQAID="PSX" D GRP1^PSXNOTE,SETUP^XQALERT K ^TMP($J,"PSXDUP")
 K LST,LSTQRY,QRYNQ,STOP,TNODE,XX0,XX1,R554,CANFLG,PSXTS,QRYN,QRYD
 Q
FILE ;store the data in the RX multiple, PSX(515
 K DD,DO,NREC,UU,VV,CC,X,AA,SS,CNT,LOT,EXPDT
 Q:'$D(^PSX(552.1,"B",NPTR))
 S UU=$O(^PSX(552.1,"B",NPTR,"")) Q:'UU  S:$G(STAT)=2 SITE=$P($P(^PSX(552.1,UU,0),"^",1),"-",1),TDT=$P(^PSX(552.1,UU,0),"^",3),PSXDIV=$P(^PSX(552.1,UU,"P"),"^")
 S CC=$O(^PSX(552.4,"B",UU,"")) Q:'CC  S NREC=CC
 I '$D(^PSX(552.4,NREC,1,"B",RXN)) Q  ;generate an error message that the rx doesn't exist
 S XDA=$O(^PSX(552.4,NREC,1,"B",RXN,""))
 I $P(^PSX(552.4,NREC,1,XDA,0),"^",9)'="" S ^TMP($J,"PSXDUP",RXN)=$G(^PSX(552.3,XX0,0)),DA=XX0,DIE="^PSX(552.3,",DR="1////3" D ^DIE K DA D  Q
 .I $G(QRYD)>0 S DA=QRYD D ^DIE K DA,DR,DIE Q
 S:$G(REASON)]"" REASON=$TR(REASON,"^"," ")
 I $G(STAT)=2 S FILL=$P(^PSX(552.4,NREC,1,XDA,0),"^",12),^TMP($J,"PSXCAN",PSXDIV,SITE,RXN)=FACBAT_"^"_FILL_"^"_TDT_"^"_$G(REASON)
 I $G(STAT)=1 S IDDRG=$P(^PSX(552.4,NREC,1,XDA,0),"^",4),IEN50=$O(^PSDRUG("AQ1",$G(IDDRG),"")) S:$G(IEN50)'="" COST=$P(^PSDRUG($G(IEN50),660),U,6) S:$G(IEN50)=""!($G(COST)="") ^TMP($J,"PSXNDG",$G(IDDRG),$G(COMDT))=RXN_"^"_NPTR
LOCK L +^PSX(552.4,NREC):30 G:'$T LOCK
 S DA=XDA,DA(1)=NREC,DIE="^PSX(552.4,"_NREC_",1,"
 S STAT1=".02////"_$G(COMDT)_";1////"_$G(STAT)_";4////"_$G(PSXNDC)_";5////"_$G(EMPID)_";8////"_$G(QRYN)_";9////1;10////"_$G(COST)_";13////"_$G(RXSTAT)_";16////"_$G(SHPDT)_";17////"_$G(CARRIER)_";18////"_$G(PKID)
 S STAT2=".02////"_$G(COMDT)_";1////"_$G(STAT)_";2////^S X=$G(REASON);5////"_$G(EMPID)_";8////"_$G(QRYN)_";9////1;13////"_$G(RXSTAT)
 S DR=$S($G(STAT)=1:STAT1,$G(STAT)=2:STAT2,1:"")
 D ^DIE K DIE,DR,DA
 L -^PSX(552.4,NREC)
 K LOT,EXPDT,CNT
 S SS=0 F  S SS=$O(PSXLOT(SS)) Q:SS'>0  S CNT=SS D
 .Q:$G(STAT)=2!($G(ZMPFLG)=1)
 .S:'$D(^PSX(552.4,NREC,1,XDA,1,0)) ^PSX(552.4,NREC,1,XDA,1,0)="^552.56A^^"
 .S LOT=$P(PSXLOT(CNT),U,1),PSXTS=$P(PSXLOT(CNT),U,2) D TSIN^PSXUTL S EXPDT=$P(PSXFM,".",1) K PSXTS,PSXFM
 .S DA(2)=NREC,DA(1)=XDA,X=LOT,DIC(0)="Z",DIC="^PSX(552.4,"_NREC_",1,"_XDA_",1,",DIC("DR")="1////"_EXPDT D FILE^DICN K DIC,LOT,EXPDT,DA,DIC("DR"),DIC(0)
 K SITE,REASON,UU,FACBAT,FILL,I,XYDA,IDDRG,IEN50
 Q
ZMP Q:$P($G(TNODE),"|",7)=""
 S (FACBAT,NPTR)=$P($P(TNODE,"|",2),"-",1,2),RXN=$P(TNODE,"|",3),STAT=$S($P(^PSX(552.3,XX0,0),"|",9)'="":2,1:"1"),REASON=$P(TNODE,"|",9),EMPID=$P(TNODE,"|",8),COMDT=$P(TNODE,"|",7),RXSTAT=2,DA=XX0,DR="1////1",DIE="^PSX(552.3,"
 D ^DIE K DA,DR,DIE
 D FILE
 Q