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

PRCFFERU.m

Go to the documentation of this file.
  1. PRCFFERU ;WISC/SJG/DL-OBLIGATION ERROR PROCESSING CON'T ;6/17/11 17:56
  1. V ;;5.1;IFCAP;**158**;Oct 20, 2000;Build 1
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. QUIT
  1. ; No top level entry
  1. NUM S PONUM=$G(GECSDATA(2100.1,GECSDATA,.01,"E"))
  1. S PONUM=$P(PONUM,"-",2)
  1. S PATNUM=$E(PONUM,4,9)
  1. S SITE=$E(PONUM,1,3)
  1. S PONUM=SITE_"-"_PATNUM
  1. S PONUM=$$STRIP(PONUM)
  1. Q
  1. GET(DIC,X) ; Get P.O. information for review
  1. K Y
  1. S DIC(0)="MNZ"
  1. D ^DIC
  1. K DIC
  1. Q
  1. STRIP(X) ; Strip trailing spaces
  1. N LOOP
  1. F LOOP=$L(X):-1:1 Q:$E(X,LOOP)'=" "
  1. S VAR=$E(X,1,LOOP)
  1. Q VAR
  1. PAUSE ; Pause screen when data is displayed
  1. W !!,"Press 'RETURN' to continue"
  1. R X:DTIME
  1. I $D(IOF) W @IOF
  1. Q
  1. PAUSE1 ; Pause screen when data is displayed
  1. W !!,"Press 'RETURN' to start the display"
  1. R X:DTIME
  1. I $D(IOF) W @IOF
  1. Q
  1. REVIEW(X) ; Prompt user to review obligation document
  1. S DIR(0)="Y"
  1. S DIR("B")="YES"
  1. S DIR("A")="Do you wish to display the source document"
  1. S DIR("?")="Enter 'NO' or 'N' or '^' if the display is not necessary."
  1. S DIR("?",1)="Enter 'YES' or 'Y' or 'RETURN' to display the source document."
  1. D ^DIR
  1. K DIR
  1. S RESP=Y
  1. I $D(Y(0)) S $P(RESP,U,2)=Y(0)
  1. I $D(DIRUT) S $P(RESP,U,3)=DIRUT
  1. Q RESP
  1. RETRANS(X) ; Prompt user to rebuild FMS doc from source doc and retransmit
  1. S DIR(0)="Y"
  1. S DIR("B")="YES"
  1. S DIR("A")="Do you wish to rebuild and retransmit this FMS document"
  1. S DIR("?")="Enter 'NO' or 'N' or '^' to exit."
  1. S DIR("?",1)="Enter 'YES' or 'Y' or 'RETURN' to rebuild/retransmit this document."
  1. D ^DIR K DIR
  1. S RETRAN=Y
  1. I $D(Y(0)) S $P(RETRAN,U,2)=Y(0)
  1. I $D(DIRUT) S $P(RETRAN,U,3)=DIRUT
  1. Q RETRAN
  1. ;
  1. ; OPT = 1 if inquiry, 2 if rebuild/retransmit
  1. STATR1(OPT) ;
  1. 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")
  1. W !,"The "_LABEL_$S(OPT=1:" will",1:" can")
  1. W " now be displayed for your review.",!!
  1. W "Please review the source document very carefully and take",!,"the appropriate corrective action.",!
  1. I OPT=1 D PAUSE
  1. I OPT=2 W ! S RESP=$$REVIEW(.RESP)
  1. Q
  1. ;
  1. FYQ(Z) ; Get Fiscal Year and Quarter
  1. N X,A,B,C,D
  1. S %DT="",X="T" D ^%DT
  1. S A=$E(Y,2,3)
  1. S B=$E(Y,4,5)
  1. S C=$E(100+$S(B>9:A+1,1:A),2,3)
  1. S D=$S(B<4:2,B<7:3,B<10:4,1:1)
  1. Q C_"^"_D