source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFFERU.m@ 1582

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

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1PRCFFERU ;WISC/SJG/DL-OBLIGATION ERROR PROCESSING CON'T ;2/2/98 1330
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 QUIT
5 ; No top level entry
6NUM S PONUM=$G(GECSDATA(2100.1,GECSDATA,.01,"E"))
7 S PONUM=$P(PONUM,"-",2)
8 S PATNUM=$E(PONUM,4,9)
9 S SITE=$E(PONUM,1,3)
10 S PONUM=SITE_"-"_PATNUM
11 S PONUM=$$STRIP(PONUM)
12 Q
13GET(DIC,X) ; Get P.O. information for review
14 K Y
15 S DIC(0)="MNZ"
16 D ^DIC
17 K DIC
18 Q
19STRIP(X) ; Strip trailing spaces
20 N LOOP
21 F LOOP=$L(X):-1:1 Q:$E(X,LOOP)'=" "
22 S VAR=$E(X,1,LOOP)
23 Q VAR
24PAUSE ; Pause screen when data is displayed
25 W !!,"Press 'RETURN' to continue"
26 R X:DTIME
27 I $D(IOF) W @IOF
28 Q
29PAUSE1 ; Pause screen when data is displayed
30 W !!,"Press 'RETURN' to start the display"
31 R X:DTIME
32 I $D(IOF) W @IOF
33 Q
34REVIEW(X) ; Prompt user to review obligation document
35 S DIR(0)="Y"
36 S DIR("B")="YES"
37 S DIR("A")="Do you wish to display the source document"
38 S DIR("?")="Enter 'NO' or 'N' or '^' if the display is not necessary."
39 S DIR("?",1)="Enter 'YES' or 'Y' or 'RETURN' to display the source document."
40 D ^DIR
41 K DIR
42 S RESP=Y
43 I $D(Y(0)) S $P(RESP,U,2)=Y(0)
44 I $D(DIRUT) S $P(RESP,U,3)=DIRUT
45 Q RESP
46RETRANS(X) ; Prompt user to rebuild FMS doc from source doc and retransmit
47 S DIR(0)="Y"
48 S DIR("B")="YES"
49 S DIR("A")="Do you wish to rebuild and retransmit this FMS document"
50 S DIR("?")="Enter 'NO' or 'N' or '^' to exit."
51 S DIR("?",1)="Enter 'YES' or 'Y' or 'RETURN' to rebuild/retransmit this document."
52 D ^DIR K DIR
53 S RETRAN=Y
54 I $D(Y(0)) S $P(RETRAN,U,2)=Y(0)
55 I $D(DIRUT) S $P(RETRAN,U,3)=DIRUT
56 Q RETRAN
57 ;
58 ; OPT = 1 if inquiry, 2 if rebuild/retransmit
59STATR1(OPT) ;
60 S LABEL=$S(MOP=1:"Purchase Order",MOP=21:"1358 Miscellaneous Obligation",MOP=7:"Imprest Fund",MOP=8:"Requistion",MOP=2:"Certified Invoice",MOP=3:"Payment in Advance",MOP=4:"Guaranteed Delivery",1:"Obligation")
61 W !,"The "_LABEL_$S(OPT=1:" will",1:" can")
62 W " now be displayed for your review.",!!
63 W "Please review the source document very carefully and take",!,"the appropriate corrective action.",!
64 I OPT=1 D PAUSE
65 I OPT=2 W ! S RESP=$$REVIEW(.RESP)
66 Q
67 ;
68FYQ(Z) ; Get Fiscal Year and Quarter
69 N X,A,B,C,D
70 S %DT="",X="T" D ^%DT
71 S A=$E(Y,2,3)
72 S B=$E(Y,4,5)
73 S C=$E(100+$S(B>9:A+1,1:A),2,3)
74 S D=$S(B<4:2,B<7:3,B<10:4,1:1)
75 Q C_"^"_D
Note: See TracBrowser for help on using the repository browser.