FBNHRCS4 ;ACAMPUS/dmk-RCS CON'T create code sheet ;1/14/98
;;3.5;FEE BASIS;**12**;JAN 30, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;create code sheets in the generic code sheet package after
;asking user. FBGECS=1 if code sheets to be created.
;
Q:'$G(FBGECS)
I $E(IOST,1,2)'="C-" W @IOF
;
S I=0
F S I=$O(^TMP($J,"FBTOT",I)) Q:'I!$G(FBOUT) D Q:$G(FBOUT)
. ; set the following GCS variables
. ; GECSSYS="FEE BASIS - GECO" (from file 2101.1)
. ; GECS("SITENOASK")=3 byte station number from 161.4 default psa
. ; GECSAUTO=BATCH that way code sheet are maked for batching
. ; GECS("TTF")=transaction type from file 2101.2
.S GECSSYS="FEE BASIS - GECO",GECSAUTO="BATCH"
.S GECS("SITENOASK")=FBSN,GECS("TTF")="18-3"
.;N %DT S X=$P($G(^TMP($J,"FBTOT",I)),U,12) D ^%DT S $P(^TMP($J,"FBTOT",I),U,12)=Y
.S GECS("STRING",0)="CNH^"_^TMP($J,"FBTOT",I)_"^$"
.D D ^GECSENTR W !
.. I $Y+5>IOSL,$E(IOST,1,2)'="C-" W @IOF
;
K GECS,GECSSYS,GECSAUTO,I
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBNHRCS4 1040 printed Oct 16, 2024@18:00:05 Page 2
FBNHRCS4 ;ACAMPUS/dmk-RCS CON'T create code sheet ;1/14/98
+1 ;;3.5;FEE BASIS;**12**;JAN 30, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;create code sheets in the generic code sheet package after
+4 ;asking user. FBGECS=1 if code sheets to be created.
+5 ;
+6 if '$GET(FBGECS)
QUIT
+7 IF $EXTRACT(IOST,1,2)'="C-"
WRITE @IOF
+8 ;
+9 SET I=0
+10 FOR
SET I=$ORDER(^TMP($JOB,"FBTOT",I))
if 'I!$GET(FBOUT)
QUIT
Begin DoDot:1
+11 ; set the following GCS variables
+12 ; GECSSYS="FEE BASIS - GECO" (from file 2101.1)
+13 ; GECS("SITENOASK")=3 byte station number from 161.4 default psa
+14 ; GECSAUTO=BATCH that way code sheet are maked for batching
+15 ; GECS("TTF")=transaction type from file 2101.2
+16 SET GECSSYS="FEE BASIS - GECO"
SET GECSAUTO="BATCH"
+17 SET GECS("SITENOASK")=FBSN
SET GECS("TTF")="18-3"
+18 ;N %DT S X=$P($G(^TMP($J,"FBTOT",I)),U,12) D ^%DT S $P(^TMP($J,"FBTOT",I),U,12)=Y
+19 SET GECS("STRING",0)="CNH^"_^TMP($JOB,"FBTOT",I)_"^$"
+20 Begin DoDot:2
+21 IF $Y+5>IOSL
IF $EXTRACT(IOST,1,2)'="C-"
WRITE @IOF
End DoDot:2
DO ^GECSENTR
WRITE !
End DoDot:1
if $GET(FBOUT)
QUIT
+22 ;
+23 KILL GECS,GECSSYS,GECSAUTO,I
+24 QUIT
