source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHRATA.m@ 1274

PRCHRATA ;SF/TKW/WISC/CLH/DL-PUBLIC LAW 100-322 REPORT--CONTINUED ;1/30/98 1315
V ;;5.1;IFCAP;;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
IFC ;IFC CONTROL STRING FROM STATION 'PRC("SITE")' TO AUSTIN, TEXAS FOR '322' TRANSACTION
 N %,B,JD,TIME,X,Y Q:$$S^%ZTLOAD
 S B="IFC^"_PRC("SITE")_"^200^322^" D NOW^%DTC S X=$P(%,".") D JD^PRCFDLN
 S JD=$E(X,1,3)+1700_$E(Y,1,3),TIME=$P(%,".",2)_"000000",TIME=$E(TIME,1,6),B=B_JD_"^"_TIME_"^"_"           "_"^001^001^001^|",PRCFA("STRING")=B
 Q
 ;
RH ;REPORT HEADER 'RH' SEGMENT OF '322' TRANSACTION
 ; ^ PIECE 2 = TOTAL 'AD' SEGMENTS IN TRANSACTION
 ; ^ PIECE 3 = TOTAL 'SU' SEGMENTS IN TRANSACTION
 N B Q:$$S^%ZTLOAD
 S B="RH^^^|",^TMP($J,"STRING",1)=B
 Q
 ;
EN ;DETAILED REPORT 'AD' SEGMENT OF '322' TRANSACTION
 N B,FRJD,HCT,HCT1,HCT2,L,LCT,LCT1,LCT2,NIIN,PRCHDESC,PRCHFSC,PRCHSEG,PRCHSRC,PRCHV,QTY,T1,T2,TOJD,TOTAL,X,Y
 Q:$$S^%ZTLOAD
 S X=FR D JD^PRCFDLN S FRJD=$E(X,1,3)+1700_$E(Y,1,3),X=TO D JD^PRCFDLN S TOJD=$E(X,1,3)+1700_$E(Y,1,3)
 S PRCHFSC="",PRCHSEG=0 F  S PRCHFSC=$O(^TMP($J,"R",PRCHFSC)) Q:PRCHFSC=""  D
RD1 .S PRCHDESC=0 F  S PRCHDESC=$O(^TMP($J,"R",PRCHFSC,PRCHDESC)) Q:PRCHDESC=""  D
RD2 ..S (PRCHV,L)="" F  S PRCHV=$O(^TMP($J,"R",PRCHFSC,PRCHDESC,PRCHV)) Q:PRCHV=""  F  S L=$O(^TMP($J,"R",PRCHFSC,PRCHDESC,PRCHV,L)) Q:L=""  S PRCHSRC="" D
 ... F  S PRCHSRC=$O(^TMP($J,"R",PRCHFSC,PRCHDESC,PRCHV,L,PRCHSRC)) Q:PRCHSRC=""  S X=^(PRCHSRC) I "2B"[$P(X,U,9) D
 ....S PRCHSEG=PRCHSEG+1,QTY=$P(X,U,4)\1,NIIN=$S($P(X,U,2)=0:"",1:$P(X,U,2)),B="AD^"_PRCHSEG_"^"_FRJD_"^"_TOJD_"^"_PRCHDESC_"^"_$P(X,U,12)_"^"_PRCHFSC_"^"_NIIN_"^"_QTY_"^"_PRCHV_"^"
 ....S TOTAL=$P(X,U,6) I TOTAL["." S T1=$P(TOTAL,"."),T2=$P(TOTAL,".",2)_"00",T2=$E(T2,1,2),TOTAL=T1_T2 G RD3
 ....S TOTAL=TOTAL_"00"
RD3 ....S LCT=$P(X,U,10) I LCT["." S LCT1=$P(LCT,"."),LCT2=$P(LCT,".",2)_"00",LCT2=$E(LCT2,1,2),LCT=LCT1_LCT2 G RD4
 ....S LCT=LCT_"00"
RD4 ....S HCT=$P(X,U,11) I HCT["." S HCT1=$P(HCT,"."),HCT2=$P(HCT,".",2)_"00",HCT2=$E(HCT2,1,2),HCT=HCT1_HCT2 G RD5
 ....S HCT=HCT_"00"
RD5 ....S B=B_TOTAL_"^"_LCT_"^"_HCT_"^|",COUNTER=COUNTER+1,^TMP($J,"STRING",COUNTER)=B Q
 ...Q
 ..Q
 .Q
 S X=^TMP($J,"STRING",1),$P(X,U,2)=PRCHSEG,^TMP($J,"STRING",1)=X
 Q
 ;
EN2 ;SUMMARY TOTALS 'SU' SEGMENT OF '322' TRANSACTION
 N AOM,AOM1,AOM2,B,FRJD,OME,OME1,OME2,PRCHFSC,PRCHSEG,T1,T2,TOJD,TOTAL,X,Y
 Q:$$S^%ZTLOAD
 S X=FR D JD^PRCFDLN S FRJD=$E(X,1,3)+1700_$E(Y,1,3),X=TO D JD^PRCFDLN S TOJD=$E(X,1,3)+1700_$E(Y,1,3)
 S PRCHFSC="",PRCHSEG=0 F  S PRCHFSC=$O(^TMP($J,"FSC",PRCHFSC)) Q:'PRCHFSC  S X=^TMP($J,"FSC",PRCHFSC) D
 .S PRCHSEG=PRCHSEG+1,B="SU^"_PRCHSEG_"^"_FRJD_"^"_TOJD_"^"_PRCHFSC_"^"
 .S TOTAL=$P(X,U,2) I TOTAL["." S T1=$P(TOTAL,"."),T2=$P(TOTAL,".",2)_"00",T2=$E(T2,1,2),TOTAL=T1_T2 G RDA
 .S TOTAL=TOTAL_"00"
RDA .S AOM=$P(X,U,3) I AOM["." S AOM1=$P(AOM,"."),AOM2=$P(AOM,".",2)_"00",AOM2=$E(AOM2,1,2),AOM=AOM1_AOM2 G RDB
 .S AOM=AOM_"00"
RDB .S OME=$P(X,U,4) I OME["." S OME1=$P(OME,"."),OME2=$P(OME,".",2)_"00",OME2=$E(OME2,1,2),OME=OME1_OME2 G RDC
 .S OME=OME_"00"
RDC .S B=B_TOTAL_"^"_AOM_"^"_OME_"^|",COUNTER=COUNTER+1,^TMP($J,"STRING",COUNTER)=B Q
 S X=^TMP($J,"STRING",1),$P(X,U,3)=PRCHSEG,^TMP($J,"STRING",1)=X
 Q
 ;
EN3 ;END OF TRANSACTION LINE AND TRANSMISSION ROUTINE CALLS
 N %,%H,%I,CSDA,MO,PRCFASYS,TEST,YR,X Q:$$S^%ZTLOAD
 S COUNTER=COUNTER+1,^TMP($J,"STRING",COUNTER)="$"
 S PRCFASYS="PRC",PRCFA("TTF")="PRC" D NOW^%DTC S YR=$E(X,2,3),MO=$E(X,4,5)
 S PRC("FY")=$E(100+$S(MO>9:YR+1,1:YR),2,3)
 D ^PRCFACX2 K ^TMP($J,"STRING") S CSDA=PRCFA("CSDA") D ^PRCFACB Q:'$D(PRCF("BTCH"))  S TEST=PRCF("BTCH"),PRCFA("ISM")="XXX@Q-PRC.VA.GOV" D ^PRCFACBT S ZTREQ="@"
 I $D(PRCOUT),(PRCOUT>0) S ^TMP($J,"RESULTS")="NOMM" Q
 S ^TMP($J,"RESULTS")="OK^"_TEST_"^"_CSDA K PRCOUT
 Q