FBUCLET.m

FBUCLET ;ALBISC/TET - UNAUTHORIZED CLAIMS LETTER ;6/26/01

 ;;3.5;FEE BASIS;**32**;JAN 30, 1995

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

AUTO(FBDA,FBORDER,FBUCA,FBUC) ;auto print - called by update routine, tasked job

 ;INPUT:  FBDA = ien of unauthorized claim, file 162.7

 ;        FBORDER = (optional) order number of status

 ;        FBUCA = current (after) zero node of unauthorized claim (162.7)

 ;        FBUC = unauthorized claim node in parameter file

 ;OUTPUT: none - task q'd to print letter and update fields upon completion

 N ZTIO,ZTRTN,ZTDESC,ZTDTH,ZTSAVE

 I $$PARAM(FBUC) S ZTIO=$P(FBUC,U,2) I ZTIO]"" D

 .S ZTRTN="AUTODQ^FBUCLET0",ZTDESC="AUTO PRINT UNAUTH CLAIM LETTER",ZTDTH=$H

 .S ZTSAVE("FBDA")="",ZTSAVE("FBORDER")="",ZTSAVE("FBUCA")="",ZTSAVE("FBUC")=""

 .D ^%ZTLOAD

 K IOP,ZTIO,ZTRTN,ZTDESC,ZTDTH,ZTSAVE,ZTSK Q

 ;

PARAM(FBUC) ;check if letter should be printed

 ;check if parameter is set to print automatically, if so,

 ;check if printer is defined, if so ok to print

 ;INPUT:  FBUC = UC node (unauthorized claim node) of parameter file

 ;OUTPUT: 1 if ok to print letter, 0 if not ok

 Q $S($P(FBUC,U,3)'="A":0,$P(FBUC,U,2)']"":0,1:1)

 ;

PRFLD(FBDA) ;check if print field is still set

 ;INPUT:  FBDA = internal entry number of unauthorized claim (162.7)

 ;OUTPUT: 1 for ok to print, 0 to not print

 Q $S('$D(^FB583("AL",1,FBDA)):0,1:1)

 ;

REPRINT ;reprint

 N %ZIS,BEGDATE,ENDDATE,DIR,DIRUT,DTOUT,DUOUT,DISP,FBDT,FBI,FBJ,FBFR,FBNOUP,FBO,FBORDER,FBOUT,FBPL,FBPOP,FBRANGE,FBTO,FBUC,FBW,IOP,X,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE

 S FBOUT=0,FBUC=$$FBUC^FBUCUTL2(1)

 S DIR("A")="Do you wish to reprint letters for a date range",DIR(0)="Y",DIR("?")="Select Yes to reprint letters for a date range; No to reprint a specific letter."

 D ^DIR K DIR G END:$D(DIRUT),REPRINT:Y<0 S FBRANGE=Y I FBRANGE D DATE^FBAAUTL G:FBPOP END

 S FBFR=$S(FBRANGE:BEGDATE-.1,1:0),FBTO=$S(FBRANGE:ENDDATE,1:DT)

 I 'FBRANGE D LOOKUP^FBUCUTL3(0) G:FBOUT!('+$G(FBARY)) END I +$G(FBARY) S DISP=1 D PARSE^FBUCUTL4(FBARY),DISPY^FBUCUTL1 G:FBOUT!('+$G(FBARY(0))) END I $G(FBARY(0))]"" D STRING(FBARY(0))

 S DIR(0)="Y",DIR("A")="Should the expiration date be updated",DIR("B")="No",DIR("?")="Answer Yes to update the expiration date based upon today's printout, No to only reprint the letter but not change the date when the information is due."

 D ^DIR K DIR G END:$D(DIRUT),ASK:Y<0 S FBNOUP=$S('Y:1,1:0)

 D COPY G:FBOUT END S FBCOPIES=$S($P(FBUC,U,4):$P(FBUC,U,4),1:1)

 W ! S %ZIS("A")="Queue to print on: ",%ZIS("B")=$P(FBUC,U,2),%ZIS="NQ0",IOP="Q"_$S($P(FBUC,U,2):";"_$P(FBUC,U,2),1:"") D ^%ZIS G:POP END S $P(FBUC,U,2)=ION,ZTIO=ION,ZTDTH=$H

 S ZTRTN="REPRNTDQ^FBUCLET0",ZTDESC="REPRINT UNAUTH CLAIM LETTERS"

 S ZTSAVE("FBUC")="",ZTSAVE("FBFR")="",ZTSAVE("FBTO")="",ZTSAVE("FBNOUP")="",ZTSAVE("FBRANGE")="",ZTSAVE("FBARY(")="" I +$G(FBIEN) S ZTSAVE("FBIEN")="",ZTSAVE("FBIX")=""

 S:'$D(ZTDTH) ZTDTH=$H D ^%ZTLOAD

 K FBARY,^TMP("FBARY",$J),^TMP("FBARY",$J) G END

BATCH ;to batch print letters & update date letter printed, interactive

 N %ZIS,DIR,DIRUT,DTOUT,DUOUT,X,Y,FBOUT,FBUC,FBZ,IOP

 S FBOUT=0,FBUC=$$FBUC^FBUCUTL2(1)

ASK D COPY G:FBOUT END

 D LTRTYP G:FBOUT END

 W ! S %ZIS("A")="Queue to print on: ",%ZIS("B")=$P(FBUC,U,2),%ZIS="NQ0",IOP="Q"_$S($P(FBUC,U,2):";"_$P(FBUC,U,2),1:"") D ^%ZIS G:POP END S $P(FBUC,U,2)=ION,ZTIO=ION,ZTDTH=$H

 S FBCOPIES=$S($P(FBUC,U,4):$P(FBUC,U,4),1:1)

 ;call taskman queue

 S ZTRTN="BATCHDQ^FBUCLET0",ZTDESC="BATCH UNAUTH CLAIM LETTERS",ZTSAVE("FBUC")=FBUC,ZTSAVE("FBCOPIES")="",ZTSAVE("FBLTRTYP")="" S:'$D(ZTDTH) ZTDTH=$H  D ^%ZTLOAD

 ;G END

END D HOME^%ZIS K DA,DIE,DIRUT,DR,DTOUT,DUOUT,FBAR,FBARY,FBEXP,FBI,FBIEN,FBLET,FBLETDT,FBOUT,FBORDER,FBP,FBP,FBUC,FBCOPIES,FBDEVICE,POP,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTREQ,ZTSAVE,ZTSK,FBLTRTYP Q

COPY ;

 S DIR(0)="161.4,35O",DIR("A")="Enter NUMBER OF COPIES for each letter",DIR("B")=$P(FBUC,U,4) D ^DIR K DIR S:$D(DIRUT) FBOUT=1 G:+Y<0 COPY S $P(FBUC,U,4)=$S(+Y=0:1,1:+Y)

 Q

LTRTYP ; ask if user just want to print a specific letter type

 ;input - none

 ;output - FBLTRTYP - false if a specific letter type was not selected OR

 ;                    ien of the selected letter type (file #161.3)

 N DIR,DIC,Y

 S FBLTRTYP=""

 S DIR(0)="Y",DIR("A")="Print all types of letters",DIR("B")="YES"

 S DIR("?",1)="Enter YES to print all types of letters.  Enter NO to"

 S DIR("?",2)="just print letters of one specific type."

 S DIR("?",3)=" "

 S DIR("?")="Enter either 'Y' or 'N'."

 D ^DIR K DIR I $D(DIRUT) S FBOUT=1 Q

 I +Y S FBLTRTYP="A" Q

 S DIC=161.3,DIC(0)="AQEM",DIC("S")="I $P(^(0),U,2)=1"

 D ^DIC K DIC I $D(DTOUT)!$D(DUOUT) S FBOUT=1 Q

 I Y<0 G LTRTYP

 S FBLTRTYP=+Y

 Q

STRING(FBY) ;set variable to string of IEN's which user selected

 ;INPUT:  FBY = fbary(0) or what user selected

 ;OUTPUT: FBARY = count of what was selected

 ;        FBARY( = string array of selected IEN's of unauthorized claims,

 ;                  delimited by ','

 N FBCT,FBDCT,FBIEN,I

 S FBDCT=($L(FBY,","))-1,FBARY=FBDCT,FBCT=0 D CT

 F I=1:1:FBDCT I '($P(FBY,",",I)#1) S FBIEN=+$G(^TMP("FBARY",$J,$P(FBY,",",I))) D:($L(FBARY(FBCT)+FBIEN+1))>245 STRIP,CT S FBARY(FBCT)=FBARY(FBCT)_","_+$G(^TMP("FBARY",$J,$P(FBY,",",I)))

 D:$E(FBARY(FBCT),1)="," STRIP

 Q

CT ;counter

 ;INPUT:  FBCT = counter

 ;OUTPUT: FBCT incremented by one

 S FBCT=FBCT+1,FBARY(FBCT)=""

 Q

STRIP ;strip comma

 ;INPUT:  FBARY(FBCT array string

 ;OUTPUT: same array string with leading comma stripped

 S FBARY(FBCT)=$P(FBARY(FBCT),",",2,($L(FBARY(FBCT),",")))

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBUCLET   5582     printed  Mar 13, 2025@21:05:09                                                                                                                                                                                                     Page 2

FBUCLET   ;ALBISC/TET - UNAUTHORIZED CLAIMS LETTER ;6/26/01

 +1       ;;3.5;FEE BASIS;**32**;JAN 30, 1995

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

AUTO(FBDA,FBORDER,FBUCA,FBUC) ;auto print - called by update routine, tasked job

 +1       ;INPUT:  FBDA = ien of unauthorized claim, file 162.7

 +2       ;        FBORDER = (optional) order number of status

 +3       ;        FBUCA = current (after) zero node of unauthorized claim (162.7)

 +4       ;        FBUC = unauthorized claim node in parameter file

 +5       ;OUTPUT: none - task q'd to print letter and update fields upon completion

 +6        NEW ZTIO,ZTRTN,ZTDESC,ZTDTH,ZTSAVE

 +7        IF $$PARAM(FBUC)

               SET ZTIO=$PIECE(FBUC,U,2)

               IF ZTIO]""

                   Begin DoDot:1

 +8                    SET ZTRTN="AUTODQ^FBUCLET0"

                       SET ZTDESC="AUTO PRINT UNAUTH CLAIM LETTER"

                       SET ZTDTH=$HOROLOG

 +9                    SET ZTSAVE("FBDA")=""

                       SET ZTSAVE("FBORDER")=""

                       SET ZTSAVE("FBUCA")=""

                       SET ZTSAVE("FBUC")=""

 +10                   DO ^%ZTLOAD

                   End DoDot:1

 +11       KILL IOP,ZTIO,ZTRTN,ZTDESC,ZTDTH,ZTSAVE,ZTSK

           QUIT 

 +12      ;

PARAM(FBUC) ;check if letter should be printed

 +1       ;check if parameter is set to print automatically, if so,

 +2       ;check if printer is defined, if so ok to print

 +3       ;INPUT:  FBUC = UC node (unauthorized claim node) of parameter file

 +4       ;OUTPUT: 1 if ok to print letter, 0 if not ok

 +5        QUIT $SELECT($PIECE(FBUC,U,3)'="A":0,$PIECE(FBUC,U,2)']"":0,1:1)

 +6       ;

PRFLD(FBDA) ;check if print field is still set

 +1       ;INPUT:  FBDA = internal entry number of unauthorized claim (162.7)

 +2       ;OUTPUT: 1 for ok to print, 0 to not print

 +3        QUIT $SELECT('$DATA(^FB583("AL",1,FBDA)):0,1:1)

 +4       ;

REPRINT   ;reprint

 +1        NEW %ZIS,BEGDATE,ENDDATE,DIR,DIRUT,DTOUT,DUOUT,DISP,FBDT,FBI,FBJ,FBFR,FBNOUP,FBO,FBORDER,FBOUT,FBPL,FBPOP,FBRANGE,FBTO,FBUC,FBW,IOP,X,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE

 +2        SET FBOUT=0

           SET FBUC=$$FBUC^FBUCUTL2(1)

 +3        SET DIR("A")="Do you wish to reprint letters for a date range"

           SET DIR(0)="Y"

           SET DIR("?")="Select Yes to reprint letters for a date range; No to reprint a specific letter."

 +4        DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               GOTO END

           if Y<0

               GOTO REPRINT

           SET FBRANGE=Y

           IF FBRANGE

               DO DATE^FBAAUTL

               if FBPOP

                   GOTO END

 +5        SET FBFR=$SELECT(FBRANGE:BEGDATE-.1,1:0)

           SET FBTO=$SELECT(FBRANGE:ENDDATE,1:DT)

 +6        IF 'FBRANGE

               DO LOOKUP^FBUCUTL3(0)

               if FBOUT!('+$GET(FBARY))

                   GOTO END

               IF +$GET(FBARY)

                   SET DISP=1

                   DO PARSE^FBUCUTL4(FBARY)

                   DO DISPY^FBUCUTL1

                   if FBOUT!('+$GET(FBARY(0)))

                       GOTO END

                   IF $GET(FBARY(0))]""

                       DO STRING(FBARY(0))

 +7        SET DIR(0)="Y"

           SET DIR("A")="Should the expiration date be updated"

           SET DIR("B")="No"

           SET DIR("?")="Answer Yes to update the expiration date based upon today's printout, No to only reprint the letter but not change the date when the information is due."

 +8        DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               GOTO END

           if Y<0

               GOTO ASK

           SET FBNOUP=$SELECT('Y:1,1:0)

 +9        DO COPY

           if FBOUT

               GOTO END

           SET FBCOPIES=$SELECT($PIECE(FBUC,U,4):$PIECE(FBUC,U,4),1:1)

 +10       WRITE !

           SET %ZIS("A")="Queue to print on: "

           SET %ZIS("B")=$PIECE(FBUC,U,2)

           SET %ZIS="NQ0"

           SET IOP="Q"_$SELECT($PIECE(FBUC,U,2):";"_$PIECE(FBUC,U,2),1:"")

           DO ^%ZIS

           if POP

               GOTO END

           SET $PIECE(FBUC,U,2)=ION

           SET ZTIO=ION

           SET ZTDTH=$HOROLOG

 +11       SET ZTRTN="REPRNTDQ^FBUCLET0"

           SET ZTDESC="REPRINT UNAUTH CLAIM LETTERS"

 +12       SET ZTSAVE("FBUC")=""

           SET ZTSAVE("FBFR")=""

           SET ZTSAVE("FBTO")=""

           SET ZTSAVE("FBNOUP")=""

           SET ZTSAVE("FBRANGE")=""

           SET ZTSAVE("FBARY(")=""

           IF +$GET(FBIEN)

               SET ZTSAVE("FBIEN")=""

               SET ZTSAVE("FBIX")=""

 +13       if '$DATA(ZTDTH)

               SET ZTDTH=$HOROLOG

           DO ^%ZTLOAD

 +14       KILL FBARY,^TMP("FBARY",$JOB),^TMP("FBARY",$JOB)

           GOTO END

BATCH     ;to batch print letters & update date letter printed, interactive

 +1        NEW %ZIS,DIR,DIRUT,DTOUT,DUOUT,X,Y,FBOUT,FBUC,FBZ,IOP

 +2        SET FBOUT=0

           SET FBUC=$$FBUC^FBUCUTL2(1)

ASK        DO COPY

           if FBOUT

               GOTO END

 +1        DO LTRTYP

           if FBOUT

               GOTO END

 +2        WRITE !

           SET %ZIS("A")="Queue to print on: "

           SET %ZIS("B")=$PIECE(FBUC,U,2)

           SET %ZIS="NQ0"

           SET IOP="Q"_$SELECT($PIECE(FBUC,U,2):";"_$PIECE(FBUC,U,2),1:"")

           DO ^%ZIS

           if POP

               GOTO END

           SET $PIECE(FBUC,U,2)=ION

           SET ZTIO=ION

           SET ZTDTH=$HOROLOG

 +3        SET FBCOPIES=$SELECT($PIECE(FBUC,U,4):$PIECE(FBUC,U,4),1:1)

 +4       ;call taskman queue

 +5        SET ZTRTN="BATCHDQ^FBUCLET0"

           SET ZTDESC="BATCH UNAUTH CLAIM LETTERS"

           SET ZTSAVE("FBUC")=FBUC

           SET ZTSAVE("FBCOPIES")=""

           SET ZTSAVE("FBLTRTYP")=""

           if '$DATA(ZTDTH)

               SET ZTDTH=$HOROLOG

           DO ^%ZTLOAD

 +6       ;G END

END        DO HOME^%ZIS

           KILL DA,DIE,DIRUT,DR,DTOUT,DUOUT,FBAR,FBARY,FBEXP,FBI,FBIEN,FBLET,FBLETDT,FBOUT,FBORDER,FBP,FBP,FBUC,FBCOPIES,FBDEVICE,POP,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTREQ,ZTSAVE,ZTSK,FBLTRTYP

           QUIT 

COPY      ;

 +1        SET DIR(0)="161.4,35O"

           SET DIR("A")="Enter NUMBER OF COPIES for each letter"

           SET DIR("B")=$PIECE(FBUC,U,4)

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               SET FBOUT=1

           if +Y<0

               GOTO COPY

           SET $PIECE(FBUC,U,4)=$SELECT(+Y=0:1,1:+Y)

 +2        QUIT 

LTRTYP    ; ask if user just want to print a specific letter type

 +1       ;input - none

 +2       ;output - FBLTRTYP - false if a specific letter type was not selected OR

 +3       ;                    ien of the selected letter type (file #161.3)

 +4        NEW DIR,DIC,Y

 +5        SET FBLTRTYP=""

 +6        SET DIR(0)="Y"

           SET DIR("A")="Print all types of letters"

           SET DIR("B")="YES"

 +7        SET DIR("?",1)="Enter YES to print all types of letters.  Enter NO to"

 +8        SET DIR("?",2)="just print letters of one specific type."

 +9        SET DIR("?",3)=" "

 +10       SET DIR("?")="Enter either 'Y' or 'N'."

 +11       DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               SET FBOUT=1

               QUIT 

 +12       IF +Y

               SET FBLTRTYP="A"

               QUIT 

 +13       SET DIC=161.3

           SET DIC(0)="AQEM"

           SET DIC("S")="I $P(^(0),U,2)=1"

 +14       DO ^DIC

           KILL DIC

           IF $DATA(DTOUT)!$DATA(DUOUT)

               SET FBOUT=1

               QUIT 

 +15       IF Y<0

               GOTO LTRTYP

 +16       SET FBLTRTYP=+Y

 +17       QUIT 

STRING(FBY) ;set variable to string of IEN's which user selected

 +1       ;INPUT:  FBY = fbary(0) or what user selected

 +2       ;OUTPUT: FBARY = count of what was selected

 +3       ;        FBARY( = string array of selected IEN's of unauthorized claims,

 +4       ;                  delimited by ','

 +5        NEW FBCT,FBDCT,FBIEN,I

 +6        SET FBDCT=($LENGTH(FBY,","))-1

           SET FBARY=FBDCT

           SET FBCT=0

           DO CT

 +7        FOR I=1:1:FBDCT

               IF '($PIECE(FBY,",",I)#1)

                   SET FBIEN=+$GET(^TMP("FBARY",$JOB,$PIECE(FBY,",",I)))

                   if ($LENGTH(FBARY(FBCT)+FBIEN+1))>245

                       DO STRIP

                       DO CT

                   SET FBARY(FBCT)=FBARY(FBCT)_","_+$GET(^TMP("FBARY",$JOB,$PIECE(FBY,",",I)))

 +8        if $EXTRACT(FBARY(FBCT),1)=","

               DO STRIP

 +9        QUIT 

CT        ;counter

 +1       ;INPUT:  FBCT = counter

 +2       ;OUTPUT: FBCT incremented by one

 +3        SET FBCT=FBCT+1

           SET FBARY(FBCT)=""

 +4        QUIT 

STRIP     ;strip comma

 +1       ;INPUT:  FBARY(FBCT array string

 +2       ;OUTPUT: same array string with leading comma stripped

 +3        SET FBARY(FBCT)=$PIECE(FBARY(FBCT),",",2,($LENGTH(FBARY(FBCT),",")))

 +4        QUIT