Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCHHI0

PRCHHI0.m

Go to the documentation of this file.
  1. PRCHHI0 ;WISC/TGH-IFCAP CONTROL STRING SEGMENT ;5/19/92 3:17 PM
  1. V ;;5.1;IFCAP;;Oct 20, 2000
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. Q
  1. CNTL(A,A1,A2,CNTR) N B,I,JD,X,Y
  1. S PRCHA=A,PRCHTC=A2
  1. D NOW^%DTC S X=$P(%,".") D JD^PRCFDLN S PRCHJD=$E(X,1,3)+1700_$E(Y,1,3)
  1. S TIME=$P(%,".",2)_"000000",TIME=$E(TIME,1,6)
  1. S PRCHTP(1,CNTR+1)="S X=PRCHSYS;500"
  1. S PRCHTP(1,CNTR+2)="S X=+$P(PRCHA,U);1"
  1. S PRCHTP(1,CNTR+3)="S X=200;63"
  1. S PRCHTP(1,CNTR+4)="S X=PRCHTC;430"
  1. S PRCHTP(1,CNTR+5)="S X=PRCHJD;501"
  1. S PRCHTP(1,CNTR+6)="S X=TIME;502"
  1. S PRCHPON=$P($P(PRCHA,U),""-"")_$P($P(PRCHA,U),""-"",2)
  1. S PRCHPON=PRCHPON_" ",PRCHPON=$E(PRCHPON,1,11)
  1. S PRCHTP(1,CNTR+7)="S X=PRCHPON;503"
  1. S PRCHTP(1,CNTR+8)="S X=""001"";503.1"
  1. S PRCHTP(1,CNTR+9)="S X=""001"";503.2"
  1. S PRCHTP(1,CNTR+10)="S X=""001"";504"
  1. S CNTR=CNTR+10
  1. S PRCFA("STRING")=""
  1. S PRCFA("STRING")=PRCHSYS_"^"_+$P(PRCHA,U)_"^200^"_PRCHTC_"^"_PRCHJD_"^"_TIME_"^"_$P($P(PRCHA,U),"-")_$P($P(PRCHA,U),"-",2)_" "_"^001^001^040^|"
  1. Q