source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHDR.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: 1.5 KB
Line 
1PRCHDR ;WISC/RHD-DISPLAY REQUEST ;2/12/98 2:43 PM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4EN ; DISPLAY 2237
5 S PRCH0=$G(^PRCS(410,D0,0))
6 S PRCHTC=$P(PRCH0,"^",2),PRCHTP="" I PRCHTC'="" S X=$P(^DD(410,1,0),U,3) F I=1:1 S Y=$P(X,";",I) Q:Y="" I $P(Y,":",1)=PRCHTC S PRCHTP=$P(Y,":",2) Q
7 W !,"Transaction Number: ",$P(PRCH0,U,1),?41,"Transaction Type: ",PRCHTP K ^UTILITY($J,"W")
8 I $O(^PRCS(410,D0,"RM",0)) S DIWL=3,DIWR=75,DIWF="" F PRCHI=0:0 S PRCHI=$O(^PRCS(410,D0,"RM",PRCHI)) Q:'PRCHI S X=^(PRCHI,0) D DIWP^PRCUTL($G(DA))
9 I $D(^UTILITY($J,"W",3)) F I=0:0 S I=$O(^UTILITY($J,"W",3,I)) Q:'I W !?3,^(I,0)
10 G:PRCHTC="CA" Q
11O S X="" D STATUS^PRCSES W !,"Supply Status: ",X G:'$D(^PRC(443,D0,0)) W1 S PRCHR0=^(0)
12 W !,"Accountable Officer: " S X=$P(PRCHR0,U,2) D US W ?45,"Date: " S Y=$P(PRCHR0,U,4) D DT
13 W !,"Purchasing Agent: " S X=$P(PRCHR0,U,5) D US W ?45,"Date: " S Y=$P(PRCHR0,U,6) D DT
14 I $P($G(^PRCS(410,D0,0)),"^",2)["O",$D(^PRCS(410,D0,"CO",0)) W !,"Comments: " N COM S COM=0 F S COM=$O(^PRCS(410,D0,"CO",COM)) Q:'COM W !,$G(^(COM,0))
15W1 W ! S %A="Would you like to print this request now",%B="",%=2 D ^PRCFYN I %=1 S DA=D0,PRCSF=1,ZTDESC="QUE^PRCSP12" D PRF1^PRCSP1 K X,PRCSF
16Q K A,B,C,DA,PRCHI,PRCH0,PRCHTC,PRCHTP,Y,^UTILITY($J,"W")
17 Q
18US ;S X=$S($D(^VA(200,+X,0)):$P(^(0),U,1),1:"") W $P(X,",",2)," ",$P(X,",",1) Q
19 S X=$P($G(^VA(200,+X,0)),U,1) W $P(X,",",2)," ",$P(X,",",1)
20 Q
21DT W:Y Y\100#100,"/",Y#100\1,"/",Y\10000+1700
22 Q
Note: See TracBrowser for help on using the repository browser.