| 1 | PSXDODQY ;BIR/HTW-Send Release Data to DoD ;04/08/97 2:06 Pm
|
|---|
| 2 | ;;2.0;CMOP;**38,45**;11 Apr 97
|
|---|
| 3 | ;Reference to $$CMOP^PSNAPIS supported by DBIA #2574
|
|---|
| 4 | DOD ; GET THE DATA FOR 1 TRANSMISSION...ZX=SITE #
|
|---|
| 5 | D NOW^%DTC S CREATEDT=$$FMTHL7^XLFDT(%),CREATEDT=$P(CREATEDT,"-") D BATCH S QRYBAT=$E(ZX,2,99)_"-"_BATCH,FILENAME=$TR(QRYBAT,"-","_")_".QRY"
|
|---|
| 6 | ;Segment order for fulfillment file. FHS,BHS,MSH,PID,NTE8,ORC,RXD,ZR2,BTS,FTS
|
|---|
| 7 | S CNT=1
|
|---|
| 8 | 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
|
|---|
| 9 | .S NODEA=$G(^PSX(552.4,AA,0))
|
|---|
| 10 | .S NODE0=$G(^PSX(552.4,AA,1,BB,0))
|
|---|
| 11 | .S NODE2=$G(^PSX(552.4,AA,1,BB,2))
|
|---|
| 12 | .S ORDER=$P($G(^PSX(552.4,AA,1,BB,3)),"^")
|
|---|
| 13 | .S FACBAT=$P(^PSX(552.1,+$P($G(NODEA),"^"),0),"^")
|
|---|
| 14 | .;Maintain full transmission # with leading 1 for file negotiations
|
|---|
| 15 | .S TRN=$S($G(ORDER):FACBAT_"-"_$G(ORDER),1:"") ; TRN= TRANSMISSION # - SITEID-BATCH#-ORDER#
|
|---|
| 16 | .S FAC1=$P(FACBAT,"-"),FACBAT=$E(FACBAT,2,99),FAC=$P(FACBAT,"-") ; FAC1=1+SITE,FAC=SITE
|
|---|
| 17 | .I CNT=1 S X=$$FMADD^XLFDT(DT,+2) S ^XTMP("PSXQRY"_QRYBAT,0)=X_U_DT_U_"CMOP DOD QUERY" K X
|
|---|
| 18 | .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)
|
|---|
| 19 | .;COMBINE CMOPID/VA PRINT NAME
|
|---|
| 20 | .S VAPRT=$$CMOP^PSNAPIS(DRG),DRG=DRG_"^"_VAPRT_"^"_"L" K VAPRT
|
|---|
| 21 | .F YY="SHPDT^4","CARRIER^5","PKGID^6" D PIECE(NODE2,DLM,YY)
|
|---|
| 22 | .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
|
|---|
| 23 | ..S EX1=$P($G(LOTX),"^",2),$P(EXPDT,"~",CC)=$$FMTHL7^XLFDT(EX1) K EX1
|
|---|
| 24 | .;Find the order containing the Rx in 552.2
|
|---|
| 25 | .S R=$O(^PSX(552.2,"B",TRN,"")) ; R=IEN 552.2
|
|---|
| 26 | .I $G(R)']"" H 1 D Q
|
|---|
| 27 | .. S ERRTXT(1)="Can't link order # from 552.4 to 552.2 ",ERRTXT(2)="Transmission #: "_FACBAT_" Order "_BB,ERRTXT(3)="Routine PSXDODQY"
|
|---|
| 28 | .. D MSG^PSXDODAC
|
|---|
| 29 | .. K ^PSX(552.4,"AC",ZX,AA,BB)
|
|---|
| 30 | .; Get info from 552.2
|
|---|
| 31 | .S RXCNT=$G(RXCNT)+1
|
|---|
| 32 | .F R1=0:0 S R1=$O(^PSX(552.2,R,"T",R1)) Q:'R1 S ND1=$G(^(R1,0)) D
|
|---|
| 33 | ..I $P($G(ND1),"|")["PID" S PID=ND1,PNAME=$P(PID,"|",6),PNAME="^"_$TR(PNAME," ","^"),$P(PID,"|",6)=PNAME
|
|---|
| 34 | ..I $P($G(ND1),"|")["NTE|8" S NTE8=ND1
|
|---|
| 35 | ..;Unmodify RXINDEX to remove leading 1
|
|---|
| 36 | ..I $P($G(ND1),"|")["RX1"&($G(ND1)[RXN) S Z1=$P(ND1,"|",2),RXINDEX=$E(Z1,2,99) K Z1
|
|---|
| 37 | ..I $G(ND1)["ZX1"&($G(ND1)[RXN) S PSXDODNM=$P($P(ND1,"|",3),"^",2)
|
|---|
| 38 | ..K ND1
|
|---|
| 39 | .S DLM="|"
|
|---|
| 40 | .I $G(CNT)=1 D
|
|---|
| 41 | ..S PSXHOME=$P($G(^PSX(554,1,0)),"^")
|
|---|
| 42 | ..S NODE="FHS|^~\&|VISTA|"_$G(PSXHOME)_"||"_$G(PSXDODNM)_"|"_$G(CREATEDT)_"||||"_FILENAME D PSXTMP
|
|---|
| 43 | ..S NODE="BHS|^~\&|VISTA|"_$G(PSXHOME)_"|"_$G(PSXDODNM)_"|"_$G(CREATEDT)_"||||"_QRYBAT D PSXTMP
|
|---|
| 44 | .S NODE="MSH|^~\&|VistA||CHCS||"_CREATEDT_"||RDS^R06|"_RXINDEX_"|P|2.3.1||||AL|AL" D PSXTMP
|
|---|
| 45 | .S NODE=PID D PSXTMP
|
|---|
| 46 | .S NODE="ORC|"_$S($G(STAT)=2:"CA",1:"OK")_"|"_RXINDEX D PSXTMP
|
|---|
| 47 | .S RXD="RXD|"
|
|---|
| 48 | .F YY="FILNUM^2","DRG^3","COMPDT^4","QTY^5","RXN^8","REASON^10","LOT^19","EXPDT^20" D PUT(.RXD,DLM,YY)
|
|---|
| 49 | .S NODE=RXD D PSXTMP
|
|---|
| 50 | .S ZR2="ZR2|" F YY="CARRIER^2","PKGID^3","RXN^4" D PUT(.ZR2,DLM,YY)
|
|---|
| 51 | .S NODE=ZR2 D PSXTMP
|
|---|
| 52 | .L +^PSX(552.4,AA,1,BB):600 Q:'$T
|
|---|
| 53 | .S DA=BB,DA(1)=AA,DIE="^PSX(552.4,"_AA_",1,",DR="9////2;15////"_BATCH D ^DIE K DA,DR,DIE
|
|---|
| 54 | .L -^PSX(552.4,AA,1,BB)
|
|---|
| 55 | KIL .K NDC,COMPDT,STAT,REASON,LOT,RXN,CARRIER,PKGID,SHPDT,NODEA,NODE1,NODE2,LOT,EXPDT,LOTX
|
|---|
| 56 | I $G(RXCNT)<1 Q
|
|---|
| 57 | S NODE="BTS|"_RXCNT_"||"_RXCNT D PSXTMP
|
|---|
| 58 | S NODE="FTS|"_1 D PSXTMP
|
|---|
| 59 | S A="PSXQRY",PATH=$P($G(^PSX(554,1,"DOD")),"^",2)
|
|---|
| 60 | F XX=1:1:5 S Y=$$GTF^%ZISH($NA(^XTMP(A_QRYBAT,1)),3,PATH,FILENAME) Q:Y=1 H 4
|
|---|
| 61 | I Y'=1 S GBL=$NA(^XTMP(A_QRYBAT)) D FALERT^PSXDODNT(FILENAME,PATH,GBL)
|
|---|
| 62 | I Y=0 S ERRTXT(2)="Failure writing to file: "_FILENAME,ERRTXT(3)="Error occurred at KIL+4^PSXDODQY" D MSG^PSXDODAC Q
|
|---|
| 63 | S PATH=$$GET1^DIQ(554,1,22)
|
|---|
| 64 | F XX=1:1:5 S Y=$$GTF^%ZISH($NA(^XTMP(A_QRYBAT,1)),3,PATH,FILENAME) Q:Y=1 H 4
|
|---|
| 65 | I Y'=1 S GBL=$NA(^XTMP(A_QRYBAT)) D FALERT^PSXDODNT(FILENAME,PATH,GBL)
|
|---|
| 66 | K DD,DO
|
|---|
| 67 | D NOW^%DTC
|
|---|
| 68 | 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
|
|---|
| 69 | K BATCH,FAC,RXCNT
|
|---|
| 70 | Q
|
|---|
| 71 | PSXTMP ;
|
|---|
| 72 | S ^XTMP("PSXQRY"_QRYBAT,CNT)=NODE S CNT=$G(CNT)+1 K NODE
|
|---|
| 73 | Q
|
|---|
| 74 | BATCH ;CREATE BATCH # YY_JULIAN DATE_HH_MM
|
|---|
| 75 | N J1,J2,JDT,X1,X2
|
|---|
| 76 | S X1=$E(%,1,3)_"0101",X2=DT+1,JDT=$$FMDIFF^XLFDT(X1,X2,1)
|
|---|
| 77 | ;change sign - to +
|
|---|
| 78 | S JDT=(JDT*-1)
|
|---|
| 79 | ;pad with 0s
|
|---|
| 80 | I $L(JDT)<3 F I=1:1:(3-$L(JDT)) S JDT="0"_JDT
|
|---|
| 81 | S J1=$E(%,2,3),J2=$E(%,9,12),BATCH=J1_JDT_J2
|
|---|
| 82 | I $L(BATCH)<9 F I=1:1:(9-$L(BATCH)) S BATCH=BATCH_"0"
|
|---|
| 83 | Q
|
|---|
| 84 | PUT(REC,DLM,XX) ;
|
|---|
| 85 | N Y,I S Y=$P(XX,U),I=$P(XX,U,2)
|
|---|
| 86 | S $P(REC,DLM,I)=$G(@Y)
|
|---|
| 87 | Q
|
|---|
| 88 | PIECE(REC,DLM,XX) ;
|
|---|
| 89 | N Y,I S Y=$P(XX,U),I=$P(XX,U,2),@Y=$P(REC,DLM,I)
|
|---|
| 90 | Q
|
|---|
