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

Last change on this file since 897 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1PRCHRATA ;SF/TKW/WISC/CLH/DL-PUBLIC LAW 100-322 REPORT--CONTINUED ;1/30/98 1315
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5IFC ;IFC CONTROL STRING FROM STATION 'PRC("SITE")' TO AUSTIN, TEXAS FOR '322' TRANSACTION
6 N %,B,JD,TIME,X,Y Q:$$S^%ZTLOAD
7 S B="IFC^"_PRC("SITE")_"^200^322^" D NOW^%DTC S X=$P(%,".") D JD^PRCFDLN
8 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
9 Q
10 ;
11RH ;REPORT HEADER 'RH' SEGMENT OF '322' TRANSACTION
12 ; ^ PIECE 2 = TOTAL 'AD' SEGMENTS IN TRANSACTION
13 ; ^ PIECE 3 = TOTAL 'SU' SEGMENTS IN TRANSACTION
14 N B Q:$$S^%ZTLOAD
15 S B="RH^^^|",^TMP($J,"STRING",1)=B
16 Q
17 ;
18EN ;DETAILED REPORT 'AD' SEGMENT OF '322' TRANSACTION
19 N B,FRJD,HCT,HCT1,HCT2,L,LCT,LCT1,LCT2,NIIN,PRCHDESC,PRCHFSC,PRCHSEG,PRCHSRC,PRCHV,QTY,T1,T2,TOJD,TOTAL,X,Y
20 Q:$$S^%ZTLOAD
21 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)
22 S PRCHFSC="",PRCHSEG=0 F S PRCHFSC=$O(^TMP($J,"R",PRCHFSC)) Q:PRCHFSC="" D
23RD1 .S PRCHDESC=0 F S PRCHDESC=$O(^TMP($J,"R",PRCHFSC,PRCHDESC)) Q:PRCHDESC="" D
24RD2 ..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
25 ... F S PRCHSRC=$O(^TMP($J,"R",PRCHFSC,PRCHDESC,PRCHV,L,PRCHSRC)) Q:PRCHSRC="" S X=^(PRCHSRC) I "2B"[$P(X,U,9) D
26 ....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_"^"
27 ....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
28 ....S TOTAL=TOTAL_"00"
29RD3 ....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
30 ....S LCT=LCT_"00"
31RD4 ....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
32 ....S HCT=HCT_"00"
33RD5 ....S B=B_TOTAL_"^"_LCT_"^"_HCT_"^|",COUNTER=COUNTER+1,^TMP($J,"STRING",COUNTER)=B Q
34 ...Q
35 ..Q
36 .Q
37 S X=^TMP($J,"STRING",1),$P(X,U,2)=PRCHSEG,^TMP($J,"STRING",1)=X
38 Q
39 ;
40EN2 ;SUMMARY TOTALS 'SU' SEGMENT OF '322' TRANSACTION
41 N AOM,AOM1,AOM2,B,FRJD,OME,OME1,OME2,PRCHFSC,PRCHSEG,T1,T2,TOJD,TOTAL,X,Y
42 Q:$$S^%ZTLOAD
43 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)
44 S PRCHFSC="",PRCHSEG=0 F S PRCHFSC=$O(^TMP($J,"FSC",PRCHFSC)) Q:'PRCHFSC S X=^TMP($J,"FSC",PRCHFSC) D
45 .S PRCHSEG=PRCHSEG+1,B="SU^"_PRCHSEG_"^"_FRJD_"^"_TOJD_"^"_PRCHFSC_"^"
46 .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
47 .S TOTAL=TOTAL_"00"
48RDA .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
49 .S AOM=AOM_"00"
50RDB .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
51 .S OME=OME_"00"
52RDC .S B=B_TOTAL_"^"_AOM_"^"_OME_"^|",COUNTER=COUNTER+1,^TMP($J,"STRING",COUNTER)=B Q
53 S X=^TMP($J,"STRING",1),$P(X,U,3)=PRCHSEG,^TMP($J,"STRING",1)=X
54 Q
55 ;
56EN3 ;END OF TRANSACTION LINE AND TRANSMISSION ROUTINE CALLS
57 N %,%H,%I,CSDA,MO,PRCFASYS,TEST,YR,X Q:$$S^%ZTLOAD
58 S COUNTER=COUNTER+1,^TMP($J,"STRING",COUNTER)="$"
59 S PRCFASYS="PRC",PRCFA("TTF")="PRC" D NOW^%DTC S YR=$E(X,2,3),MO=$E(X,4,5)
60 S PRC("FY")=$E(100+$S(MO>9:YR+1,1:YR),2,3)
61 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="@"
62 I $D(PRCOUT),(PRCOUT>0) S ^TMP($J,"RESULTS")="NOMM" Q
63 S ^TMP($J,"RESULTS")="OK^"_TEST_"^"_CSDA K PRCOUT
64 Q
Note: See TracBrowser for help on using the repository browser.