91 lines
4.4 KiB
Mathematica
91 lines
4.4 KiB
Mathematica
PSXDODQY ;BIR/HTW-Send Release Data to DoD ;04/08/97 2:06 Pm
|
|
;;2.0;CMOP;**38,45**;11 Apr 97
|
|
;Reference to $$CMOP^PSNAPIS supported by DBIA #2574
|
|
DOD ; GET THE DATA FOR 1 TRANSMISSION...ZX=SITE #
|
|
D NOW^%DTC S CREATEDT=$$FMTHL7^XLFDT(%),CREATEDT=$P(CREATEDT,"-") D BATCH S QRYBAT=$E(ZX,2,99)_"-"_BATCH,FILENAME=$TR(QRYBAT,"-","_")_".QRY"
|
|
;Segment order for fulfillment file. FHS,BHS,MSH,PID,NTE8,ORC,RXD,ZR2,BTS,FTS
|
|
S CNT=1
|
|
F AA=0:0 S AA=$O(^PSX(552.4,"AC",ZX,AA)) Q:AA'>0 S BB=0 F S BB=$O(^PSX(552.4,"AC",ZX,AA,BB)) Q:BB'>0 D
|
|
.S NODEA=$G(^PSX(552.4,AA,0))
|
|
.S NODE0=$G(^PSX(552.4,AA,1,BB,0))
|
|
.S NODE2=$G(^PSX(552.4,AA,1,BB,2))
|
|
.S ORDER=$P($G(^PSX(552.4,AA,1,BB,3)),"^")
|
|
.S FACBAT=$P(^PSX(552.1,+$P($G(NODEA),"^"),0),"^")
|
|
.;Maintain full transmission # with leading 1 for file negotiations
|
|
.S TRN=$S($G(ORDER):FACBAT_"-"_$G(ORDER),1:"") ; TRN= TRANSMISSION # - SITEID-BATCH#-ORDER#
|
|
.S FAC1=$P(FACBAT,"-"),FACBAT=$E(FACBAT,2,99),FAC=$P(FACBAT,"-") ; FAC1=1+SITE,FAC=SITE
|
|
.I CNT=1 S X=$$FMADD^XLFDT(DT,+2) S ^XTMP("PSXQRY"_QRYBAT,0)=X_U_DT_U_"CMOP DOD QUERY" K X
|
|
.F YY="RXN^1","STAT^2","REASON^3","DRG^4","NDC^5","COMPDT^9","FILNUM^12","QTY^13" S DLM="^" D PIECE(NODE0,DLM,YY)
|
|
.;COMBINE CMOPID/VA PRINT NAME
|
|
.S VAPRT=$$CMOP^PSNAPIS(DRG),DRG=DRG_"^"_VAPRT_"^"_"L" K VAPRT
|
|
.F YY="SHPDT^4","CARRIER^5","PKGID^6" D PIECE(NODE2,DLM,YY)
|
|
.F CC=0:0 S CC=$O(^PSX(552.4,AA,1,BB,1,CC)) Q:CC'>0 S LOTX=$G(^PSX(552.4,AA,1,BB,1,CC,0)),$P(LOT,"~",CC)=$P($G(LOTX),"^") D
|
|
..S EX1=$P($G(LOTX),"^",2),$P(EXPDT,"~",CC)=$$FMTHL7^XLFDT(EX1) K EX1
|
|
.;Find the order containing the Rx in 552.2
|
|
.S R=$O(^PSX(552.2,"B",TRN,"")) ; R=IEN 552.2
|
|
.I $G(R)']"" H 1 D Q
|
|
.. S ERRTXT(1)="Can't link order # from 552.4 to 552.2 ",ERRTXT(2)="Transmission #: "_FACBAT_" Order "_BB,ERRTXT(3)="Routine PSXDODQY"
|
|
.. D MSG^PSXDODAC
|
|
.. K ^PSX(552.4,"AC",ZX,AA,BB)
|
|
.; Get info from 552.2
|
|
.S RXCNT=$G(RXCNT)+1
|
|
.F R1=0:0 S R1=$O(^PSX(552.2,R,"T",R1)) Q:'R1 S ND1=$G(^(R1,0)) D
|
|
..I $P($G(ND1),"|")["PID" S PID=ND1,PNAME=$P(PID,"|",6),PNAME="^"_$TR(PNAME," ","^"),$P(PID,"|",6)=PNAME
|
|
..I $P($G(ND1),"|")["NTE|8" S NTE8=ND1
|
|
..;Unmodify RXINDEX to remove leading 1
|
|
..I $P($G(ND1),"|")["RX1"&($G(ND1)[RXN) S Z1=$P(ND1,"|",2),RXINDEX=$E(Z1,2,99) K Z1
|
|
..I $G(ND1)["ZX1"&($G(ND1)[RXN) S PSXDODNM=$P($P(ND1,"|",3),"^",2)
|
|
..K ND1
|
|
.S DLM="|"
|
|
.I $G(CNT)=1 D
|
|
..S PSXHOME=$P($G(^PSX(554,1,0)),"^")
|
|
..S NODE="FHS|^~\&|VISTA|"_$G(PSXHOME)_"||"_$G(PSXDODNM)_"|"_$G(CREATEDT)_"||||"_FILENAME D PSXTMP
|
|
..S NODE="BHS|^~\&|VISTA|"_$G(PSXHOME)_"|"_$G(PSXDODNM)_"|"_$G(CREATEDT)_"||||"_QRYBAT D PSXTMP
|
|
.S NODE="MSH|^~\&|VistA||CHCS||"_CREATEDT_"||RDS^R06|"_RXINDEX_"|P|2.3.1||||AL|AL" D PSXTMP
|
|
.S NODE=PID D PSXTMP
|
|
.S NODE="ORC|"_$S($G(STAT)=2:"CA",1:"OK")_"|"_RXINDEX D PSXTMP
|
|
.S RXD="RXD|"
|
|
.F YY="FILNUM^2","DRG^3","COMPDT^4","QTY^5","RXN^8","REASON^10","LOT^19","EXPDT^20" D PUT(.RXD,DLM,YY)
|
|
.S NODE=RXD D PSXTMP
|
|
.S ZR2="ZR2|" F YY="CARRIER^2","PKGID^3","RXN^4" D PUT(.ZR2,DLM,YY)
|
|
.S NODE=ZR2 D PSXTMP
|
|
.L +^PSX(552.4,AA,1,BB):600 Q:'$T
|
|
.S DA=BB,DA(1)=AA,DIE="^PSX(552.4,"_AA_",1,",DR="9////2;15////"_BATCH D ^DIE K DA,DR,DIE
|
|
.L -^PSX(552.4,AA,1,BB)
|
|
KIL .K NDC,COMPDT,STAT,REASON,LOT,RXN,CARRIER,PKGID,SHPDT,NODEA,NODE1,NODE2,LOT,EXPDT,LOTX
|
|
I $G(RXCNT)<1 Q
|
|
S NODE="BTS|"_RXCNT_"||"_RXCNT D PSXTMP
|
|
S NODE="FTS|"_1 D PSXTMP
|
|
S A="PSXQRY",PATH=$P($G(^PSX(554,1,"DOD")),"^",2)
|
|
F XX=1:1:5 S Y=$$GTF^%ZISH($NA(^XTMP(A_QRYBAT,1)),3,PATH,FILENAME) Q:Y=1 H 4
|
|
I Y'=1 S GBL=$NA(^XTMP(A_QRYBAT)) D FALERT^PSXDODNT(FILENAME,PATH,GBL)
|
|
I Y=0 S ERRTXT(2)="Failure writing to file: "_FILENAME,ERRTXT(3)="Error occurred at KIL+4^PSXDODQY" D MSG^PSXDODAC Q
|
|
S PATH=$$GET1^DIQ(554,1,22)
|
|
F XX=1:1:5 S Y=$$GTF^%ZISH($NA(^XTMP(A_QRYBAT,1)),3,PATH,FILENAME) Q:Y=1 H 4
|
|
I Y'=1 S GBL=$NA(^XTMP(A_QRYBAT)) D FALERT^PSXDODNT(FILENAME,PATH,GBL)
|
|
K DD,DO
|
|
D NOW^%DTC
|
|
S DA(1)=1,DIC="^PSX(554,"_DA(1)_",3,",DIC(0)="Z",DIC("DR")="1////"_BATCH_";2////"_FAC1_";5////"_RXCNT,X=% D FILE^DICN K DIC,DA,DIC("DR"),DIC(0),X,TRX
|
|
K BATCH,FAC,RXCNT
|
|
Q
|
|
PSXTMP ;
|
|
S ^XTMP("PSXQRY"_QRYBAT,CNT)=NODE S CNT=$G(CNT)+1 K NODE
|
|
Q
|
|
BATCH ;CREATE BATCH # YY_JULIAN DATE_HH_MM
|
|
N J1,J2,JDT,X1,X2
|
|
S X1=$E(%,1,3)_"0101",X2=DT+1,JDT=$$FMDIFF^XLFDT(X1,X2,1)
|
|
;change sign - to +
|
|
S JDT=(JDT*-1)
|
|
;pad with 0s
|
|
I $L(JDT)<3 F I=1:1:(3-$L(JDT)) S JDT="0"_JDT
|
|
S J1=$E(%,2,3),J2=$E(%,9,12),BATCH=J1_JDT_J2
|
|
I $L(BATCH)<9 F I=1:1:(9-$L(BATCH)) S BATCH=BATCH_"0"
|
|
Q
|
|
PUT(REC,DLM,XX) ;
|
|
N Y,I S Y=$P(XX,U),I=$P(XX,U,2)
|
|
S $P(REC,DLM,I)=$G(@Y)
|
|
Q
|
|
PIECE(REC,DLM,XX) ;
|
|
N Y,I S Y=$P(XX,U),I=$P(XX,U,2),@Y=$P(REC,DLM,I)
|
|
Q
|