- ACRFPAA ;IHS/OIRM/DSD/THL,AEF - PRINT ADVICE OF ALLOWANCE; [ 11/01/2001 9:44 AM ]
- ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
- ;;ROUTINE TO PRINT ADVICE OF ALLOWANCE
- EN D EN1
- EXIT K ^TMP("SSA",$J),ACRO1,ACRO2,ACRO3,ACRO4,ACRQ1,ACRO1,ACRI1,ACRD1,ACRQ2,ACRO2,ACRI2,ACRD2,ACRQ3,ACRO3,ACRI3,ACRD3,ACRQ4,ACRO4,ACRI4,ACRD4,ACRGTOT,ACRQ1,ACRQ2,ACRQ3,ACRQ4,ACRTI,ACRI1,ACRI2,ACRI3,ACRI4,ACRTD,ACRD1,ACRD2
- K ACRD3,ACRD4,ACRFY,ACRSSANO,ACRTOT,ACRREC,ACRNREC,ACRSSA,ACRREC,ACRNREC,ACRTOT,ACRRTOT,ACRNTOT,ACRSSA,ACRX,ACRI,ACRALW,ACRAMDNO,ACRTODAY,ACRTO,ACRSTRET,ACRCITY,ACRSTATE,ACRZIP,ACRAPP,ACRAPPNO,ACRAPT,ACRBA,ACRBANO
- W @IOF
- Q
- EN1 S ACRX="HEADQUARTERS FINANCE"
- W !?80-$L(ACRX)\2,ACRX
- W !
- F ACRI=1:1:79 W "-"
- W !,"TO:"
- W ?40,"ALLOWANCE"
- W ?52,"AMENDMENT"
- W ?63,"DATE"
- W !,"DIRECTOR"
- W ?40,$E(ACRFY,2),"-",ACRALW
- W ?56,ACRAMDNO
- W ?63,ACRTODAY
- W !,ACRTO
- W ?40
- F ACRI=1:1:39 W "-"
- W !,ACRSTRET
- W ?40,"ALLOTMENT NO."
- W !,ACRCITY,", ",ACRSTATE," ",ACRZIP
- W ?42,ACRALW
- W !?40
- F ACRI=1:1:39 W "-"
- W !?40,"APPROPRIATION SYMBOL"
- W !?42,ACRAPP
- W !?40
- F ACRI=1:1:39 W "-"
- W !?40,"ACTIVITY"
- W ?65,"ACC'T POINT"
- W !?40,ACRBA
- W ?67,ACRAPT
- W !
- F ACRI=1:1:79 W "-"
- W !?19,"FIRST"
- W ?32,"SECOND"
- W ?45,"THIRD"
- W ?59,"FOURTH"
- W !?19,"QUARTER"
- W ?32,"QUARTER"
- W ?45,"QUARTER"
- W ?59,"QUARTER"
- W ?71,"TOTAL"
- W !
- F ACRI=1:1:79 W "-"
- W !,"ORIGINAL"
- S ACRTO=ACRO1+ACRO2+ACRO3+ACRO4,ACRQ1=ACRO1+ACRI1+ACRD1,ACRQ2=ACRO2+ACRI2+ACRD2,ACRQ3=ACRO3+ACRI3+ACRD3,ACRQ4=ACRO4+ACRI4+ACRD4,ACRGTOT=ACRQ1+ACRQ2+ACRQ3+ACRQ4,ACRTI=ACRI1+ACRI2+ACRI3+ACRI4,ACRTD=ACRD1+ACRD2+ACRD3+ACRD4
- W !,"ALLOWANCE"
- W ?15,$J(ACRO1,11)
- W ?28,$J(ACRO2,11)
- W ?41,$J(ACRO3,11)
- W ?54,$J(ACRO4,11)
- W ?67,$J(ACRTO,11)
- W !
- F ACRI=1:1:79 W "-"
- W !!,"INCREASE"
- W ?15,$J(ACRI1,11)
- W ?28,$J(ACRI2,11)
- W ?41,$J(ACRI3,11)
- W ?54,$J(ACRI4,11)
- W ?67,$J(ACRTI,11)
- W !
- F ACRI=1:1:79 W "-"
- W !!,"DECREASE"
- W ?15,$J(ACRD1,11)
- W ?28,$J(ACRD2,11)
- W ?41,$J(ACRD3,11)
- W ?54,$J(ACRD4,11)
- W ?67,$J(ACRTD,11)
- W !
- F ACRI=1:1:79 W "-"
- W !!,"QUARTER"
- W ?15,$J(ACRQ1,11)
- W ?28,$J(ACRQ2,11)
- W ?41,$J(ACRQ3,11)
- W ?54,$J(ACRQ4,11)
- W ?67,$J(ACRGTOT,11)
- W !
- F ACRI=1:1:79 W "-"
- W !,"CURRENT DISTRIBUTION:"
- S ACRPRT=$S(ACRGREF["ALW":"^ACRFALT",ACRGREF["ALC":"^ACRFALC",1:"^ACRFLOC")
- N DXS,DIP,DC,D0,DN
- S D0=ACRZDA
- D @ACRPRT
- W !!,"DISTRIBUTION"
- W ?37,"RECURRING"
- W ?50,"NON-RECURRG"
- W ?68,"TOTAL"
- W !,"-----------------------------"
- W ?35,"-----------"
- W ?50,"-----------"
- W ?65,"-----------"
- S (ACRSSANO,ACRGTOT,ACRRTOT,ACRNTOT)=0
- F S ACRSSANO=$O(^TMP("SSA",$J,"TOT",ACRSSANO)) Q:'ACRSSANO D
- .D SET
- .D WRITE
- S ACRGTOT=ACRRTOT+ACRNTOT
- W !,"-----------------------------"
- W ?35,"-----------"
- W ?50,"-----------"
- W ?65,"-----------"
- W !,"TOTAL ALLOWANCES"
- W ?35,$J(ACRRTOT,11)
- W ?50,$J(ACRNTOT,11)
- W ?65,$J(ACRGTOT,11)
- W !
- F ACRI=1:1:79 W "-"
- W !,"CERTIFIED-DIVISION OF FINANCE-PHS"
- W ?40,"SIGNATURE"
- W !!?40,"CARL FITZPATRICK"
- W !?40
- F ACRI=1:1:39 W "-"
- W !?40,"Director, Division of Resource Mgt"
- W !?40,"Indian Health Service"
- Q
- SET S (ACRTOT,ACRREC,ACRNREC)=0
- S ACRSSA=$P(^AUTTSSA(ACRSSANO,0),U,2)
- S ACRX=^TMP("SSA",$J,"TOT",ACRSSANO)
- S ACRREC=$P(ACRX,U)
- S ACRNREC=$P(ACRX,U,2)
- S ACRTOT=ACRREC+ACRNREC
- S ACRRTOT=ACRRTOT+ACRREC
- S ACRNTOT=ACRNTOT+ACRNREC
- Q
- WRITE W !,ACRSSA
- W ?35,$J(ACRREC,11)
- W ?50,$J(ACRNREC,11)
- W ?65,$J(ACRTOT,11)
- Q
- ACRFPAA ;IHS/OIRM/DSD/THL,AEF - PRINT ADVICE OF ALLOWANCE; [ 11/01/2001 9:44 AM ]
- +1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
- +2 ;;ROUTINE TO PRINT ADVICE OF ALLOWANCE
- EN DO EN1
- EXIT KILL ^TMP("SSA",$JOB),ACRO1,ACRO2,ACRO3,ACRO4,ACRQ1,ACRO1,ACRI1,ACRD1,ACRQ2,ACRO2,ACRI2,ACRD2,ACRQ3,ACRO3,ACRI3,ACRD3,ACRQ4,ACRO4,ACRI4,ACRD4,ACRGTOT,ACRQ1,ACRQ2,ACRQ3,ACRQ4,ACRTI,ACRI1,ACRI2,ACRI3,ACRI4,ACRTD,ACRD1,ACRD2
- +1 KILL ACRD3,ACRD4,ACRFY,ACRSSANO,ACRTOT,ACRREC,ACRNREC,ACRSSA,ACRREC,ACRNREC,ACRTOT,ACRRTOT,ACRNTOT,ACRSSA,ACRX,ACRI,ACRALW,ACRAMDNO,ACRTODAY,ACRTO,ACRSTRET,ACRCITY,ACRSTATE,ACRZIP,ACRAPP,ACRAPPNO,ACRAPT,ACRBA,ACRBANO
- +2 WRITE @IOF
- +3 QUIT
- EN1 SET ACRX="HEADQUARTERS FINANCE"
- +1 WRITE !?80-$LENGTH(ACRX)\2,ACRX
- +2 WRITE !
- +3 FOR ACRI=1:1:79
- WRITE "-"
- +4 WRITE !,"TO:"
- +5 WRITE ?40,"ALLOWANCE"
- +6 WRITE ?52,"AMENDMENT"
- +7 WRITE ?63,"DATE"
- +8 WRITE !,"DIRECTOR"
- +9 WRITE ?40,$EXTRACT(ACRFY,2),"-",ACRALW
- +10 WRITE ?56,ACRAMDNO
- +11 WRITE ?63,ACRTODAY
- +12 WRITE !,ACRTO
- +13 WRITE ?40
- +14 FOR ACRI=1:1:39
- WRITE "-"
- +15 WRITE !,ACRSTRET
- +16 WRITE ?40,"ALLOTMENT NO."
- +17 WRITE !,ACRCITY,", ",ACRSTATE," ",ACRZIP
- +18 WRITE ?42,ACRALW
- +19 WRITE !?40
- +20 FOR ACRI=1:1:39
- WRITE "-"
- +21 WRITE !?40,"APPROPRIATION SYMBOL"
- +22 WRITE !?42,ACRAPP
- +23 WRITE !?40
- +24 FOR ACRI=1:1:39
- WRITE "-"
- +25 WRITE !?40,"ACTIVITY"
- +26 WRITE ?65,"ACC'T POINT"
- +27 WRITE !?40,ACRBA
- +28 WRITE ?67,ACRAPT
- +29 WRITE !
- +30 FOR ACRI=1:1:79
- WRITE "-"
- +31 WRITE !?19,"FIRST"
- +32 WRITE ?32,"SECOND"
- +33 WRITE ?45,"THIRD"
- +34 WRITE ?59,"FOURTH"
- +35 WRITE !?19,"QUARTER"
- +36 WRITE ?32,"QUARTER"
- +37 WRITE ?45,"QUARTER"
- +38 WRITE ?59,"QUARTER"
- +39 WRITE ?71,"TOTAL"
- +40 WRITE !
- +41 FOR ACRI=1:1:79
- WRITE "-"
- +42 WRITE !,"ORIGINAL"
- +43 SET ACRTO=ACRO1+ACRO2+ACRO3+ACRO4
- SET ACRQ1=ACRO1+ACRI1+ACRD1
- SET ACRQ2=ACRO2+ACRI2+ACRD2
- SET ACRQ3=ACRO3+ACRI3+ACRD3
- SET ACRQ4=ACRO4+ACRI4+ACRD4
- SET ACRGTOT=ACRQ1+ACRQ2+ACRQ3+ACRQ4
- SET ACRTI=ACRI1+ACRI2+ACRI3+ACRI4
- SET ACRTD=ACRD1+ACRD2+ACRD3+ACRD4
- +44 WRITE !,"ALLOWANCE"
- +45 WRITE ?15,$JUSTIFY(ACRO1,11)
- +46 WRITE ?28,$JUSTIFY(ACRO2,11)
- +47 WRITE ?41,$JUSTIFY(ACRO3,11)
- +48 WRITE ?54,$JUSTIFY(ACRO4,11)
- +49 WRITE ?67,$JUSTIFY(ACRTO,11)
- +50 WRITE !
- +51 FOR ACRI=1:1:79
- WRITE "-"
- +52 WRITE !!,"INCREASE"
- +53 WRITE ?15,$JUSTIFY(ACRI1,11)
- +54 WRITE ?28,$JUSTIFY(ACRI2,11)
- +55 WRITE ?41,$JUSTIFY(ACRI3,11)
- +56 WRITE ?54,$JUSTIFY(ACRI4,11)
- +57 WRITE ?67,$JUSTIFY(ACRTI,11)
- +58 WRITE !
- +59 FOR ACRI=1:1:79
- WRITE "-"
- +60 WRITE !!,"DECREASE"
- +61 WRITE ?15,$JUSTIFY(ACRD1,11)
- +62 WRITE ?28,$JUSTIFY(ACRD2,11)
- +63 WRITE ?41,$JUSTIFY(ACRD3,11)
- +64 WRITE ?54,$JUSTIFY(ACRD4,11)
- +65 WRITE ?67,$JUSTIFY(ACRTD,11)
- +66 WRITE !
- +67 FOR ACRI=1:1:79
- WRITE "-"
- +68 WRITE !!,"QUARTER"
- +69 WRITE ?15,$JUSTIFY(ACRQ1,11)
- +70 WRITE ?28,$JUSTIFY(ACRQ2,11)
- +71 WRITE ?41,$JUSTIFY(ACRQ3,11)
- +72 WRITE ?54,$JUSTIFY(ACRQ4,11)
- +73 WRITE ?67,$JUSTIFY(ACRGTOT,11)
- +74 WRITE !
- +75 FOR ACRI=1:1:79
- WRITE "-"
- +76 WRITE !,"CURRENT DISTRIBUTION:"
- +77 SET ACRPRT=$SELECT(ACRGREF["ALW":"^ACRFALT",ACRGREF["ALC":"^ACRFALC",1:"^ACRFLOC")
- +78 NEW DXS,DIP,DC,D0,DN
- +79 SET D0=ACRZDA
- +80 DO @ACRPRT
- +81 WRITE !!,"DISTRIBUTION"
- +82 WRITE ?37,"RECURRING"
- +83 WRITE ?50,"NON-RECURRG"
- +84 WRITE ?68,"TOTAL"
- +85 WRITE !,"-----------------------------"
- +86 WRITE ?35,"-----------"
- +87 WRITE ?50,"-----------"
- +88 WRITE ?65,"-----------"
- +89 SET (ACRSSANO,ACRGTOT,ACRRTOT,ACRNTOT)=0
- +90 FOR
- SET ACRSSANO=$ORDER(^TMP("SSA",$JOB,"TOT",ACRSSANO))
- IF 'ACRSSANO
- QUIT
- Begin DoDot:1
- +91 DO SET
- +92 DO WRITE
- End DoDot:1
- +93 SET ACRGTOT=ACRRTOT+ACRNTOT
- +94 WRITE !,"-----------------------------"
- +95 WRITE ?35,"-----------"
- +96 WRITE ?50,"-----------"
- +97 WRITE ?65,"-----------"
- +98 WRITE !,"TOTAL ALLOWANCES"
- +99 WRITE ?35,$JUSTIFY(ACRRTOT,11)
- +100 WRITE ?50,$JUSTIFY(ACRNTOT,11)
- +101 WRITE ?65,$JUSTIFY(ACRGTOT,11)
- +102 WRITE !
- +103 FOR ACRI=1:1:79
- WRITE "-"
- +104 WRITE !,"CERTIFIED-DIVISION OF FINANCE-PHS"
- +105 WRITE ?40,"SIGNATURE"
- +106 WRITE !!?40,"CARL FITZPATRICK"
- +107 WRITE !?40
- +108 FOR ACRI=1:1:39
- WRITE "-"
- +109 WRITE !?40,"Director, Division of Resource Mgt"
- +110 WRITE !?40,"Indian Health Service"
- +111 QUIT
- SET SET (ACRTOT,ACRREC,ACRNREC)=0
- +1 SET ACRSSA=$PIECE(^AUTTSSA(ACRSSANO,0),U,2)
- +2 SET ACRX=^TMP("SSA",$JOB,"TOT",ACRSSANO)
- +3 SET ACRREC=$PIECE(ACRX,U)
- +4 SET ACRNREC=$PIECE(ACRX,U,2)
- +5 SET ACRTOT=ACRREC+ACRNREC
- +6 SET ACRRTOT=ACRRTOT+ACRREC
- +7 SET ACRNTOT=ACRNTOT+ACRNREC
- +8 QUIT
- WRITE WRITE !,ACRSSA
- +1 WRITE ?35,$JUSTIFY(ACRREC,11)
- +2 WRITE ?50,$JUSTIFY(ACRNREC,11)
- +3 WRITE ?65,$JUSTIFY(ACRTOT,11)
- +4 QUIT
