- 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 ---[H[J[2J[HFBUCLET 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