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
