FBNHRCS4.m

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 ---FBNHRCS4   1040     printed  Apr 09, 2024@21:05:13                                                                                                                                                                                                    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