| 1 | FBUCLET ;ALBISC/TET - UNAUTHORIZED CLAIMS LETTER ;6/26/01
|
---|
| 2 | ;;3.5;FEE BASIS;**32**;JAN 30, 1995
|
---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
| 4 | AUTO(FBDA,FBORDER,FBUCA,FBUC) ;auto print - called by update routine, tasked job
|
---|
| 5 | ;INPUT: FBDA = ien of unauthorized claim, file 162.7
|
---|
| 6 | ; FBORDER = (optional) order number of status
|
---|
| 7 | ; FBUCA = current (after) zero node of unauthorized claim (162.7)
|
---|
| 8 | ; FBUC = unauthorized claim node in parameter file
|
---|
| 9 | ;OUTPUT: none - task q'd to print letter and update fields upon completion
|
---|
| 10 | N ZTIO,ZTRTN,ZTDESC,ZTDTH,ZTSAVE
|
---|
| 11 | I $$PARAM(FBUC) S ZTIO=$P(FBUC,U,2) I ZTIO]"" D
|
---|
| 12 | .S ZTRTN="AUTODQ^FBUCLET0",ZTDESC="AUTO PRINT UNAUTH CLAIM LETTER",ZTDTH=$H
|
---|
| 13 | .S ZTSAVE("FBDA")="",ZTSAVE("FBORDER")="",ZTSAVE("FBUCA")="",ZTSAVE("FBUC")=""
|
---|
| 14 | .D ^%ZTLOAD
|
---|
| 15 | K IOP,ZTIO,ZTRTN,ZTDESC,ZTDTH,ZTSAVE,ZTSK Q
|
---|
| 16 | ;
|
---|
| 17 | PARAM(FBUC) ;check if letter should be printed
|
---|
| 18 | ;check if parameter is set to print automatically, if so,
|
---|
| 19 | ;check if printer is defined, if so ok to print
|
---|
| 20 | ;INPUT: FBUC = UC node (unauthorized claim node) of parameter file
|
---|
| 21 | ;OUTPUT: 1 if ok to print letter, 0 if not ok
|
---|
| 22 | Q $S($P(FBUC,U,3)'="A":0,$P(FBUC,U,2)']"":0,1:1)
|
---|
| 23 | ;
|
---|
| 24 | PRFLD(FBDA) ;check if print field is still set
|
---|
| 25 | ;INPUT: FBDA = internal entry number of unauthorized claim (162.7)
|
---|
| 26 | ;OUTPUT: 1 for ok to print, 0 to not print
|
---|
| 27 | Q $S('$D(^FB583("AL",1,FBDA)):0,1:1)
|
---|
| 28 | ;
|
---|
| 29 | REPRINT ;reprint
|
---|
| 30 | 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
|
---|
| 31 | S FBOUT=0,FBUC=$$FBUC^FBUCUTL2(1)
|
---|
| 32 | 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."
|
---|
| 33 | D ^DIR K DIR G END:$D(DIRUT),REPRINT:Y<0 S FBRANGE=Y I FBRANGE D DATE^FBAAUTL G:FBPOP END
|
---|
| 34 | S FBFR=$S(FBRANGE:BEGDATE-.1,1:0),FBTO=$S(FBRANGE:ENDDATE,1:DT)
|
---|
| 35 | 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))
|
---|
| 36 | 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."
|
---|
| 37 | D ^DIR K DIR G END:$D(DIRUT),ASK:Y<0 S FBNOUP=$S('Y:1,1:0)
|
---|
| 38 | D COPY G:FBOUT END S FBCOPIES=$S($P(FBUC,U,4):$P(FBUC,U,4),1:1)
|
---|
| 39 | 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
|
---|
| 40 | S ZTRTN="REPRNTDQ^FBUCLET0",ZTDESC="REPRINT UNAUTH CLAIM LETTERS"
|
---|
| 41 | S ZTSAVE("FBUC")="",ZTSAVE("FBFR")="",ZTSAVE("FBTO")="",ZTSAVE("FBNOUP")="",ZTSAVE("FBRANGE")="",ZTSAVE("FBARY(")="" I +$G(FBIEN) S ZTSAVE("FBIEN")="",ZTSAVE("FBIX")=""
|
---|
| 42 | S:'$D(ZTDTH) ZTDTH=$H D ^%ZTLOAD
|
---|
| 43 | K FBARY,^TMP("FBARY",$J),^TMP("FBARY",$J) G END
|
---|
| 44 | BATCH ;to batch print letters & update date letter printed, interactive
|
---|
| 45 | N %ZIS,DIR,DIRUT,DTOUT,DUOUT,X,Y,FBOUT,FBUC,FBZ,IOP
|
---|
| 46 | S FBOUT=0,FBUC=$$FBUC^FBUCUTL2(1)
|
---|
| 47 | ASK D COPY G:FBOUT END
|
---|
| 48 | D LTRTYP G:FBOUT END
|
---|
| 49 | 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
|
---|
| 50 | S FBCOPIES=$S($P(FBUC,U,4):$P(FBUC,U,4),1:1)
|
---|
| 51 | ;call taskman queue
|
---|
| 52 | S ZTRTN="BATCHDQ^FBUCLET0",ZTDESC="BATCH UNAUTH CLAIM LETTERS",ZTSAVE("FBUC")=FBUC,ZTSAVE("FBCOPIES")="",ZTSAVE("FBLTRTYP")="" S:'$D(ZTDTH) ZTDTH=$H D ^%ZTLOAD
|
---|
| 53 | ;G END
|
---|
| 54 | 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
|
---|
| 55 | COPY ;
|
---|
| 56 | 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)
|
---|
| 57 | Q
|
---|
| 58 | LTRTYP ; ask if user just want to print a specific letter type
|
---|
| 59 | ;input - none
|
---|
| 60 | ;output - FBLTRTYP - false if a specific letter type was not selected OR
|
---|
| 61 | ; ien of the selected letter type (file #161.3)
|
---|
| 62 | N DIR,DIC,Y
|
---|
| 63 | S FBLTRTYP=""
|
---|
| 64 | S DIR(0)="Y",DIR("A")="Print all types of letters",DIR("B")="YES"
|
---|
| 65 | S DIR("?",1)="Enter YES to print all types of letters. Enter NO to"
|
---|
| 66 | S DIR("?",2)="just print letters of one specific type."
|
---|
| 67 | S DIR("?",3)=" "
|
---|
| 68 | S DIR("?")="Enter either 'Y' or 'N'."
|
---|
| 69 | D ^DIR K DIR I $D(DIRUT) S FBOUT=1 Q
|
---|
| 70 | I +Y S FBLTRTYP="A" Q
|
---|
| 71 | S DIC=161.3,DIC(0)="AQEM",DIC("S")="I $P(^(0),U,2)=1"
|
---|
| 72 | D ^DIC K DIC I $D(DTOUT)!$D(DUOUT) S FBOUT=1 Q
|
---|
| 73 | I Y<0 G LTRTYP
|
---|
| 74 | S FBLTRTYP=+Y
|
---|
| 75 | Q
|
---|
| 76 | STRING(FBY) ;set variable to string of IEN's which user selected
|
---|
| 77 | ;INPUT: FBY = fbary(0) or what user selected
|
---|
| 78 | ;OUTPUT: FBARY = count of what was selected
|
---|
| 79 | ; FBARY( = string array of selected IEN's of unauthorized claims,
|
---|
| 80 | ; delimited by ','
|
---|
| 81 | N FBCT,FBDCT,FBIEN,I
|
---|
| 82 | S FBDCT=($L(FBY,","))-1,FBARY=FBDCT,FBCT=0 D CT
|
---|
| 83 | 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)))
|
---|
| 84 | D:$E(FBARY(FBCT),1)="," STRIP
|
---|
| 85 | Q
|
---|
| 86 | CT ;counter
|
---|
| 87 | ;INPUT: FBCT = counter
|
---|
| 88 | ;OUTPUT: FBCT incremented by one
|
---|
| 89 | S FBCT=FBCT+1,FBARY(FBCT)=""
|
---|
| 90 | Q
|
---|
| 91 | STRIP ;strip comma
|
---|
| 92 | ;INPUT: FBARY(FBCT array string
|
---|
| 93 | ;OUTPUT: same array string with leading comma stripped
|
---|
| 94 | S FBARY(FBCT)=$P(FBARY(FBCT),",",2,($L(FBARY(FBCT),",")))
|
---|
| 95 | Q
|
---|