source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHHI0.m@ 1006

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

initial load of WorldVistAEHR

File size: 1018 bytes
Line 
1PRCHHI0 ;WISC/TGH-IFCAP CONTROL STRING SEGMENT ;5/19/92 3:17 PM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5CNTL(A,A1,A2,CNTR) N B,I,JD,X,Y
6 S PRCHA=A,PRCHTC=A2
7 D NOW^%DTC S X=$P(%,".") D JD^PRCFDLN S PRCHJD=$E(X,1,3)+1700_$E(Y,1,3)
8 S TIME=$P(%,".",2)_"000000",TIME=$E(TIME,1,6)
9 S PRCHTP(1,CNTR+1)="S X=PRCHSYS;500"
10 S PRCHTP(1,CNTR+2)="S X=+$P(PRCHA,U);1"
11 S PRCHTP(1,CNTR+3)="S X=200;63"
12 S PRCHTP(1,CNTR+4)="S X=PRCHTC;430"
13 S PRCHTP(1,CNTR+5)="S X=PRCHJD;501"
14 S PRCHTP(1,CNTR+6)="S X=TIME;502"
15 S PRCHPON=$P($P(PRCHA,U),""-"")_$P($P(PRCHA,U),""-"",2)
16 S PRCHPON=PRCHPON_" ",PRCHPON=$E(PRCHPON,1,11)
17 S PRCHTP(1,CNTR+7)="S X=PRCHPON;503"
18 S PRCHTP(1,CNTR+8)="S X=""001"";503.1"
19 S PRCHTP(1,CNTR+9)="S X=""001"";503.2"
20 S PRCHTP(1,CNTR+10)="S X=""001"";504"
21 S CNTR=CNTR+10
22 S PRCFA("STRING")=""
23 S PRCFA("STRING")=PRCHSYS_"^"_+$P(PRCHA,U)_"^200^"_PRCHTC_"^"_PRCHJD_"^"_TIME_"^"_$P($P(PRCHA,U),"-")_$P($P(PRCHA,U),"-",2)_" "_"^001^001^040^|"
24 Q
Note: See TracBrowser for help on using the repository browser.