PRCFDA4 ;(Wash ISC)/LKG-PROCESS INVOICE FOR PAYMENT ;26 SEP 95
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
AUTOACCR ;Check if AutoAccrue field answered
N PRCFBBY,PRCFW,PRCFY,PRCFZ,MOP,DA,DR,DIE
S PRCFY=$G(^PRC(442,PRCF("PODA"),10,1,0)),PRCFZ=$P($P(PRCFY,U),".")
S MOP=$P($G(^PRC(442,PRCF("PODA"),0)),U,2)
S PRCFZ=$S(PRCFZ?2U:PRCFZ,MOP=2:"SO",MOP=21:"SO",1:"MO")
Q:PRCFZ'="SO"
I $P($G(^PRC(442,PRCF("PODA"),23)),U,6)]"" Q
S PRCFBBY=1700+$E($P($G(^PRC(442,PRCF("PODA"),23)),U,2),1,3)
I PRCFBBY<$$CVNFY^PRCFD8L("IFCAP",5.0) S PRCFW="NO" G AUTOASK
S PRCFW="YES"
I $P(PRCFY,".")=921,";10;60;"[(";"_$P(PRCFY,".",2)_";") D
. I $P(PRCFY,".",2)=60 S PRCFW="YES" Q
. S PRCFY=$P(PRCFY,U,4),PRCFY=$S(PRCFY?1.N:$P($G(^PRCF(423,PRCFY,1)),U,3),1:"")
. S PRCFW=$S(PRCFY=6:"YES",PRCFY=7:"YES",1:"NO")
AUTOASK W !,"As the Service Order associated with this Invoice lacks a value for the",!," Auto-Accrue Flag, you will now be asked."
S DIE=442,DR="30//^S X=PRCFW",DA=PRCF("PODA") D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFDA4 1059 printed Dec 13, 2024@02:02:49 Page 2
PRCFDA4 ;(Wash ISC)/LKG-PROCESS INVOICE FOR PAYMENT ;26 SEP 95
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
AUTOACCR ;Check if AutoAccrue field answered
+1 NEW PRCFBBY,PRCFW,PRCFY,PRCFZ,MOP,DA,DR,DIE
+2 SET PRCFY=$GET(^PRC(442,PRCF("PODA"),10,1,0))
SET PRCFZ=$PIECE($PIECE(PRCFY,U),".")
+3 SET MOP=$PIECE($GET(^PRC(442,PRCF("PODA"),0)),U,2)
+4 SET PRCFZ=$SELECT(PRCFZ?2U:PRCFZ,MOP=2:"SO",MOP=21:"SO",1:"MO")
+5 if PRCFZ'="SO"
QUIT
+6 IF $PIECE($GET(^PRC(442,PRCF("PODA"),23)),U,6)]""
QUIT
+7 SET PRCFBBY=1700+$EXTRACT($PIECE($GET(^PRC(442,PRCF("PODA"),23)),U,2),1,3)
+8 IF PRCFBBY<$$CVNFY^PRCFD8L("IFCAP",5.0)
SET PRCFW="NO"
GOTO AUTOASK
+9 SET PRCFW="YES"
+10 IF $PIECE(PRCFY,".")=921
IF ";10;60;"[(";"_$PIECE(PRCFY,".",2)_";")
Begin DoDot:1
+11 IF $PIECE(PRCFY,".",2)=60
SET PRCFW="YES"
QUIT
+12 SET PRCFY=$PIECE(PRCFY,U,4)
SET PRCFY=$SELECT(PRCFY?1.N:$PIECE($GET(^PRCF(423,PRCFY,1)),U,3),1:"")
+13 SET PRCFW=$SELECT(PRCFY=6:"YES",PRCFY=7:"YES",1:"NO")
End DoDot:1
AUTOASK WRITE !,"As the Service Order associated with this Invoice lacks a value for the",!," Auto-Accrue Flag, you will now be asked."
+1 SET DIE=442
SET DR="30//^S X=PRCFW"
SET DA=PRCF("PODA")
DO ^DIE
+2 QUIT
