PRCFFERU ;WISC/SJG/DL-OBLIGATION ERROR PROCESSING CON'T ;6/17/11 17:56
V ;;5.1;IFCAP;**158**;Oct 20, 2000;Build 1
;Per VHA Directive 2004-038, this routine should not be modified.
QUIT
; No top level entry
NUM S PONUM=$G(GECSDATA(2100.1,GECSDATA,.01,"E"))
S PONUM=$P(PONUM,"-",2)
S PATNUM=$E(PONUM,4,9)
S SITE=$E(PONUM,1,3)
S PONUM=SITE_"-"_PATNUM
S PONUM=$$STRIP(PONUM)
Q
GET(DIC,X) ; Get P.O. information for review
K Y
S DIC(0)="MNZ"
D ^DIC
K DIC
Q
STRIP(X) ; Strip trailing spaces
N LOOP
F LOOP=$L(X):-1:1 Q:$E(X,LOOP)'=" "
S VAR=$E(X,1,LOOP)
Q VAR
PAUSE ; Pause screen when data is displayed
W !!,"Press 'RETURN' to continue"
R X:DTIME
I $D(IOF) W @IOF
Q
PAUSE1 ; Pause screen when data is displayed
W !!,"Press 'RETURN' to start the display"
R X:DTIME
I $D(IOF) W @IOF
Q
REVIEW(X) ; Prompt user to review obligation document
S DIR(0)="Y"
S DIR("B")="YES"
S DIR("A")="Do you wish to display the source document"
S DIR("?")="Enter 'NO' or 'N' or '^' if the display is not necessary."
S DIR("?",1)="Enter 'YES' or 'Y' or 'RETURN' to display the source document."
D ^DIR
K DIR
S RESP=Y
I $D(Y(0)) S $P(RESP,U,2)=Y(0)
I $D(DIRUT) S $P(RESP,U,3)=DIRUT
Q RESP
RETRANS(X) ; Prompt user to rebuild FMS doc from source doc and retransmit
S DIR(0)="Y"
S DIR("B")="YES"
S DIR("A")="Do you wish to rebuild and retransmit this FMS document"
S DIR("?")="Enter 'NO' or 'N' or '^' to exit."
S DIR("?",1)="Enter 'YES' or 'Y' or 'RETURN' to rebuild/retransmit this document."
D ^DIR K DIR
S RETRAN=Y
I $D(Y(0)) S $P(RETRAN,U,2)=Y(0)
I $D(DIRUT) S $P(RETRAN,U,3)=DIRUT
Q RETRAN
;
; OPT = 1 if inquiry, 2 if rebuild/retransmit
STATR1(OPT) ;
S LABEL=$S(MOP=1:"Purchase Order",MOP=21:"1358 Obligation",MOP=7:"Imprest Fund",MOP=8:"Requistion",MOP=2:"Certified Invoice",MOP=3:"Payment in Advance",MOP=4:"Guaranteed Delivery",1:"Obligation")
W !,"The "_LABEL_$S(OPT=1:" will",1:" can")
W " now be displayed for your review.",!!
W "Please review the source document very carefully and take",!,"the appropriate corrective action.",!
I OPT=1 D PAUSE
I OPT=2 W ! S RESP=$$REVIEW(.RESP)
Q
;
FYQ(Z) ; Get Fiscal Year and Quarter
N X,A,B,C,D
S %DT="",X="T" D ^%DT
S A=$E(Y,2,3)
S B=$E(Y,4,5)
S C=$E(100+$S(B>9:A+1,1:A),2,3)
S D=$S(B<4:2,B<7:3,B<10:4,1:1)
Q C_"^"_D
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFFERU 2378 printed Apr 09, 2024@21:06:24 Page 2
PRCFFERU ;WISC/SJG/DL-OBLIGATION ERROR PROCESSING CON'T ;6/17/11 17:56
V ;;5.1;IFCAP;**158**;Oct 20, 2000;Build 1
+1 ;Per VHA Directive 2004-038, this routine should not be modified.
+2 QUIT
+3 ; No top level entry
NUM SET PONUM=$GET(GECSDATA(2100.1,GECSDATA,.01,"E"))
+1 SET PONUM=$PIECE(PONUM,"-",2)
+2 SET PATNUM=$EXTRACT(PONUM,4,9)
+3 SET SITE=$EXTRACT(PONUM,1,3)
+4 SET PONUM=SITE_"-"_PATNUM
+5 SET PONUM=$$STRIP(PONUM)
+6 QUIT
GET(DIC,X) ; Get P.O. information for review
+1 KILL Y
+2 SET DIC(0)="MNZ"
+3 DO ^DIC
+4 KILL DIC
+5 QUIT
STRIP(X) ; Strip trailing spaces
+1 NEW LOOP
+2 FOR LOOP=$LENGTH(X):-1:1
if $EXTRACT(X,LOOP)'=" "
QUIT
+3 SET VAR=$EXTRACT(X,1,LOOP)
+4 QUIT VAR
PAUSE ; Pause screen when data is displayed
+1 WRITE !!,"Press 'RETURN' to continue"
+2 READ X:DTIME
+3 IF $DATA(IOF)
WRITE @IOF
+4 QUIT
PAUSE1 ; Pause screen when data is displayed
+1 WRITE !!,"Press 'RETURN' to start the display"
+2 READ X:DTIME
+3 IF $DATA(IOF)
WRITE @IOF
+4 QUIT
REVIEW(X) ; Prompt user to review obligation document
+1 SET DIR(0)="Y"
+2 SET DIR("B")="YES"
+3 SET DIR("A")="Do you wish to display the source document"
+4 SET DIR("?")="Enter 'NO' or 'N' or '^' if the display is not necessary."
+5 SET DIR("?",1)="Enter 'YES' or 'Y' or 'RETURN' to display the source document."
+6 DO ^DIR
+7 KILL DIR
+8 SET RESP=Y
+9 IF $DATA(Y(0))
SET $PIECE(RESP,U,2)=Y(0)
+10 IF $DATA(DIRUT)
SET $PIECE(RESP,U,3)=DIRUT
+11 QUIT RESP
RETRANS(X) ; Prompt user to rebuild FMS doc from source doc and retransmit
+1 SET DIR(0)="Y"
+2 SET DIR("B")="YES"
+3 SET DIR("A")="Do you wish to rebuild and retransmit this FMS document"
+4 SET DIR("?")="Enter 'NO' or 'N' or '^' to exit."
+5 SET DIR("?",1)="Enter 'YES' or 'Y' or 'RETURN' to rebuild/retransmit this document."
+6 DO ^DIR
KILL DIR
+7 SET RETRAN=Y
+8 IF $DATA(Y(0))
SET $PIECE(RETRAN,U,2)=Y(0)
+9 IF $DATA(DIRUT)
SET $PIECE(RETRAN,U,3)=DIRUT
+10 QUIT RETRAN
+11 ;
+12 ; OPT = 1 if inquiry, 2 if rebuild/retransmit
STATR1(OPT) ;
+1 SET LABEL=$SELECT(MOP=1:"Purchase Order",MOP=21:"1358 Obligation",MOP=7:"Imprest Fund",MOP=8:"Requistion",MOP=2:"Certified Invoice",MOP=3:"Payment in Advance",MOP=4:"Guaranteed Delivery",1:"Obligation")
+2 WRITE !,"The "_LABEL_$SELECT(OPT=1:" will",1:" can")
+3 WRITE " now be displayed for your review.",!!
+4 WRITE "Please review the source document very carefully and take",!,"the appropriate corrective action.",!
+5 IF OPT=1
DO PAUSE
+6 IF OPT=2
WRITE !
SET RESP=$$REVIEW(.RESP)
+7 QUIT
+8 ;
FYQ(Z) ; Get Fiscal Year and Quarter
+1 NEW X,A,B,C,D
+2 SET %DT=""
SET X="T"
DO ^%DT
+3 SET A=$EXTRACT(Y,2,3)
+4 SET B=$EXTRACT(Y,4,5)
+5 SET C=$EXTRACT(100+$SELECT(B>9:A+1,1:A),2,3)
+6 SET D=$SELECT(B<4:2,B<7:3,B<10:4,1:1)
+7 QUIT C_"^"_D
