ACRFSSD1 ;IHS/OIRM/DSD/THL,AEF - DISPLAY SERVICES/SUPPLIES INFO - CON'T; [ 09/23/2005 4:16 PM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,14,19**;NOV 05, 2001
;;CONTINUATION OF ACRFSSD
NOTES ;EP;DISPLAY NOTES - CALLED BY FILEMAN TEMPLATE
Q:'$D(^ACROBL(ACRDOCDA,"NOTES"))&'$D(^ACROBL(ACRDOCDA,"NOTES2"))
N X,Y
S X=$G(^ACROBL(ACRDOCDA,"NOTES"))
S Y=$G(^ACROBL(ACRDOCDA,"NOTES2"))
D D
Q
JUST ;EP;DISPLAY JUSTIFICATION - CALLED BY FILEMAN TEMPLATE
Q:'$D(^ACROBL(ACRDOCDA,"JST"))&'$D(^ACROBL(ACRDOCDA,"JST2"))
N X,Y
S X=$G(^ACROBL(ACRDOCDA,"JST"))
S Y=$G(^ACROBL(ACRDOCDA,"JST2"))
D D
Q
INFO ;EP;DISPLAY INFO CHANGED - CALLED BY FILEMAN TEMPLATE
Q:'$D(^ACROBL(ACRDOCDA,"CNG"))
N X,Y
S X=$G(^ACROBL(ACRDOCDA,"CNG"))
S Y=""
D D
Q
REASON ;EP;DISPLAY REASON FOR CHANGE - CALLED BY FILEMAN TEMPLATE
Q:'$D(^ACROBL(ACRDOCDA,"RSN"))
N X,Y
S X=$G(^ACROBL(ACRDOCDA,"RSN"))
S Y=""
D D
Q
ADDM ;EP;PRINT ADDITIONAL DESCRIPTION FOR AN ITEM
Q:'$D(^ACRSS(ACRSSDA,1,1,0))#2
N ACR
S ACR=0
F S ACR=$O(^ACRSS(ACRSSDA,1,ACR)) Q:'ACR S ACRDISP=^(ACR,0) D
.S ACRDC=$S($G(ACRDC):ACRDC,1:$G(DC))
.I ACRDISP["|TAB|" F I=1:1 S ACRDISP=$P(ACRDISP,"|TAB|")_" "_$P(ACRDISP,"|TAB|",2) Q:ACRDISP'["|TAB|"
.I ACRDISP]"" D
..D P
..W !?3
..W:'$D(ACRORIGF) "|"
..W ?4,ACRDISP
..D W
Q
SSNOTES ;EP;PRINT SPECIAL REMARKS FOR AN ITEM
N I,X
Q:'$D(^ACRSS(ACRSSDA,"NOTES"))
S ACRNOTES=^ACRSS(ACRSSDA,"NOTES")
Q:ACRNOTES=""
S X=ACRNOTES,ACRDISP=""
F I=1:1:5 S:$P(X,U,I)]"" ACRDISP=ACRDISP_$P(X,U,I)_" "
Q:ACRDISP=""
W !?3
W:'$D(ACRORIGF) "|"
D P
DISP N J,X
Q:'$D(ACRDISP)#2
F J=1:1:$L(ACRDISP," ") D
.S X=$P(ACRDISP," ",J)
.I X]"" D
..D P
..I $X+$L(X)+1<75 W ?4,X," "
..E D
...D W,P
...W !?3
...W:'$D(ACRORIGF) "|"
...W ?4,X
D W
K ACRDISP
Q
P D P^ACRFSSD
Q
W D W^ACRFSSD
Q
HEAD ;EP;
Q:$D(ACROUT)
I $E(IOST,1,2)="C-" D
.W @IOF
.W !?10,@ACRON,"ITEMS",@ACROF," FOR DOCUMENT: ",@ACRON,ACRDOC,@ACROF
.W " ",$$EXPDN^ACRFUTL(ACRDOCDA) ;ACR*2.1*14.01 IM12272
I ACRREFX=103!(ACRREFX=349)!(ACRREFX=326),$D(DC),DC>1 W $$DASH^ACRFMENU
I (ACRREFX'=103&(ACRREFX'=349)&(ACRREFX'=326))!'$D(DC) W $$DASH^ACRFMENU
W !,"ITM|"
W ?34,"|QUAN"
W ?41,"|"
W ?44,"| UNIT"
W ?55,"| ITEM"
W ?67,"|"
I ACRREFX'=103&(ACRREFX'=349)&(ACRREFX'=326)&'$D(ACRPRT)&'$D(ACRPQT) D
.W ?68,"OBJ"
.W ?72,"|"
W:ACRREFX=103&'$D(ACRPQT) ?68,"QUANTITY"
W !,"NO.|"
W ?8,"SUPPLIES OR SERVICES"
W ?34,"|ORD'D"
W ?41,"|UI"
W ?44,"| PRICE"
W ?55,"| TOTAL"
W ?67,"|"
I ACRREFX'=103&(ACRREFX'=349)&(ACRREFX'=326)&'$D(ACRPRT)&'$D(ACRPQT) D
.W ?68,"CODE"
.W ?72,"|CAN NO."
W:ACRREFX=103&'$D(ACRPQT) ?68,"ACCEPTED"
W !,"(A)|"
W ?4," (B) "
W ?34,"| (C)"
W ?41,"|D)"
W ?44,"| (E)"
W ?55,"| (F)"
W ?67,"|"
I ACRREFX'=103&'$D(ACRPRT) D
.W ?68,"----"
.W ?72,"|-------"
W:ACRREFX=103&'$D(ACRPQT) ?68," (G)"
W !,"---|"
W ?4,"------------------------------"
W ?34,"|------"
W ?41,"|--"
W ?44,"|----------"
W ?55,"|-----------"
W ?67,"|"
I ACRREFX'=103&(ACRREFX'=349)&(ACRREFX'=326)&'$D(ACRPRT)&'$D(ACRPQT) D
.W ?68,"----"
.W ?72,"|-------"
W:ACRREFX=103&'$D(ACRPQT) ?68,"--------"
Q
HEADSS4 ;EP;
Q:$D(ACROUT)
W @IOF
W !?10,"DHHS/INDIAN HEALTH SERVICE - TRAVEL ",$S(ACRREFX=130:"EXPENSE ESTIMATE",1:"VOUCHER")
W !?4,"TRAVEL ORDER: ",ACRDOC
W ?40,"TRAVELER: "
N ACRX
S ACRX=$P($G(^ACRDOC(ACRDOCDA,"TO")),U,9) ;ACR*2.1*3.44
I 'ACRX D Q
.W !,"TRAVELER'S NAME MUST BE ENTERED BEFORE YOU PROCEED."
.D PAUSE^ACRFWARN
.S (ACRQUIT,ACROUT)=""
;E S ACRX=$P(^VA(200,ACRX,0),U) ;ACR*2.1*19.02 IM16848
E S ACRX=$$NAME2^ACRFUTL1(ACRX) ;ACR*2.1*19.02 IM16848
W ACRX
W !,"DHHS #: ",$$EXPDN^ACRFUTL(ACRDOCDA) ;ACR*2.1*14.01 IM12272
W:ACRREFX=600 !,"SCHEDULE OF EXPENSES AND AMOUNTS CLAIMED"
W $$DASH^ACRFMENU
SS41 ;EP;
W !,"DAY"
W ?3,"DATE"
W ?8,"DEPT"
W ?13,"ARRV"
W ?18,"CITY"
W ?26," M & IE"
W ?36,"LODGING"
W ?46,"MILES"
W ?54,"TAXI"
W ?63,"CALL HOM"
W ?72,"OTHER"
W !,"--"
W ?3,"----"
W ?8,"----"
W ?13,"----"
W ?18,"-------"
W ?26,"---------"
W ?36,"---------"
W ?46,"-------"
W ?54,"--------"
W ?63,"--------"
W ?72,"-------"
Q
D ;DISPLAY PROCESSOR
S ACRX=""
F Z=X,Y F I=1:1:5 S:$P(Z,U,I)]"" ACRX=ACRX_$P(Z,U,I)_" "
Q:ACRX=""
W !
D D1
W "-----------------------------"
W ?(80-$L(ACRY))\2,ACRY
W ?50,"-----------------------------"
D D1
W !
D D2
W ?5
N J
F J=1:1:$L(ACRX," ") D
.S X=$P(ACRX," ",J)
.I X]"" D
..I $X+$L(X)+1>75 D
...W ?79
...D D2
...W !
...D D2
...W ?5
..W X
..W ?$X+1
I ACRX]"" W ?79 D D2
Q
D1 W $S(ACRREFX'=600:"|",1:"-")
Q
D2 W $S(ACRREFX'=600:"|",1:" ")
Q
ACRFSSD1 ;IHS/OIRM/DSD/THL,AEF - DISPLAY SERVICES/SUPPLIES INFO - CON'T; [ 09/23/2005 4:16 PM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,14,19**;NOV 05, 2001
+2 ;;CONTINUATION OF ACRFSSD
NOTES ;EP;DISPLAY NOTES - CALLED BY FILEMAN TEMPLATE
+1 IF '$DATA(^ACROBL(ACRDOCDA,"NOTES"))&'$DATA(^ACROBL(ACRDOCDA,"NOTES2"))
QUIT
+2 NEW X,Y
+3 SET X=$GET(^ACROBL(ACRDOCDA,"NOTES"))
+4 SET Y=$GET(^ACROBL(ACRDOCDA,"NOTES2"))
+5 DO D
+6 QUIT
JUST ;EP;DISPLAY JUSTIFICATION - CALLED BY FILEMAN TEMPLATE
+1 IF '$DATA(^ACROBL(ACRDOCDA,"JST"))&'$DATA(^ACROBL(ACRDOCDA,"JST2"))
QUIT
+2 NEW X,Y
+3 SET X=$GET(^ACROBL(ACRDOCDA,"JST"))
+4 SET Y=$GET(^ACROBL(ACRDOCDA,"JST2"))
+5 DO D
+6 QUIT
INFO ;EP;DISPLAY INFO CHANGED - CALLED BY FILEMAN TEMPLATE
+1 IF '$DATA(^ACROBL(ACRDOCDA,"CNG"))
QUIT
+2 NEW X,Y
+3 SET X=$GET(^ACROBL(ACRDOCDA,"CNG"))
+4 SET Y=""
+5 DO D
+6 QUIT
REASON ;EP;DISPLAY REASON FOR CHANGE - CALLED BY FILEMAN TEMPLATE
+1 IF '$DATA(^ACROBL(ACRDOCDA,"RSN"))
QUIT
+2 NEW X,Y
+3 SET X=$GET(^ACROBL(ACRDOCDA,"RSN"))
+4 SET Y=""
+5 DO D
+6 QUIT
ADDM ;EP;PRINT ADDITIONAL DESCRIPTION FOR AN ITEM
+1 IF '$DATA(^ACRSS(ACRSSDA,1,1,0))#2
QUIT
+2 NEW ACR
+3 SET ACR=0
+4 FOR
SET ACR=$ORDER(^ACRSS(ACRSSDA,1,ACR))
IF 'ACR
QUIT
SET ACRDISP=^(ACR,0)
Begin DoDot:1
+5 SET ACRDC=$SELECT($GET(ACRDC):ACRDC,1:$GET(DC))
+6 IF ACRDISP["|TAB|"
FOR I=1:1
SET ACRDISP=$PIECE(ACRDISP,"|TAB|")_" "_$PIECE(ACRDISP,"|TAB|",2)
IF ACRDISP'["|TAB|"
QUIT
+7 IF ACRDISP]""
Begin DoDot:2
+8 DO P
+9 WRITE !?3
+10 IF '$DATA(ACRORIGF)
WRITE "|"
+11 WRITE ?4,ACRDISP
+12 DO W
End DoDot:2
End DoDot:1
+13 QUIT
SSNOTES ;EP;PRINT SPECIAL REMARKS FOR AN ITEM
+1 NEW I,X
+2 IF '$DATA(^ACRSS(ACRSSDA,"NOTES"))
QUIT
+3 SET ACRNOTES=^ACRSS(ACRSSDA,"NOTES")
+4 IF ACRNOTES=""
QUIT
+5 SET X=ACRNOTES
SET ACRDISP=""
+6 FOR I=1:1:5
IF $PIECE(X,U,I)]""
SET ACRDISP=ACRDISP_$PIECE(X,U,I)_" "
+7 IF ACRDISP=""
QUIT
+8 WRITE !?3
+9 IF '$DATA(ACRORIGF)
WRITE "|"
+10 DO P
DISP NEW J,X
+1 IF '$DATA(ACRDISP)#2
QUIT
+2 FOR J=1:1:$LENGTH(ACRDISP," ")
Begin DoDot:1
+3 SET X=$PIECE(ACRDISP," ",J)
+4 IF X]""
Begin DoDot:2
+5 DO P
+6 IF $X+$LENGTH(X)+1<75
WRITE ?4,X," "
+7 IF '$TEST
Begin DoDot:3
+8 DO W
DO P
+9 WRITE !?3
+10 IF '$DATA(ACRORIGF)
WRITE "|"
+11 WRITE ?4,X
End DoDot:3
End DoDot:2
End DoDot:1
+12 DO W
+13 KILL ACRDISP
+14 QUIT
P DO P^ACRFSSD
+1 QUIT
W DO W^ACRFSSD
+1 QUIT
HEAD ;EP;
+1 IF $DATA(ACROUT)
QUIT
+2 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+3 WRITE @IOF
+4 WRITE !?10,@ACRON,"ITEMS",@ACROF," FOR DOCUMENT: ",@ACRON,ACRDOC,@ACROF
+5 ;ACR*2.1*14.01 IM12272
WRITE " ",$$EXPDN^ACRFUTL(ACRDOCDA)
End DoDot:1
+6 IF ACRREFX=103!(ACRREFX=349)!(ACRREFX=326)
IF $DATA(DC)
IF DC>1
WRITE $$DASH^ACRFMENU
+7 IF (ACRREFX'=103&(ACRREFX'=349)&(ACRREFX'=326))!'$DATA(DC)
WRITE $$DASH^ACRFMENU
+8 WRITE !,"ITM|"
+9 WRITE ?34,"|QUAN"
+10 WRITE ?41,"|"
+11 WRITE ?44,"| UNIT"
+12 WRITE ?55,"| ITEM"
+13 WRITE ?67,"|"
+14 IF ACRREFX'=103&(ACRREFX'=349)&(ACRREFX'=326)&'$DATA(ACRPRT)&'$DATA(ACRPQT)
Begin DoDot:1
+15 WRITE ?68,"OBJ"
+16 WRITE ?72,"|"
End DoDot:1
+17 IF ACRREFX=103&'$DATA(ACRPQT)
WRITE ?68,"QUANTITY"
+18 WRITE !,"NO.|"
+19 WRITE ?8,"SUPPLIES OR SERVICES"
+20 WRITE ?34,"|ORD'D"
+21 WRITE ?41,"|UI"
+22 WRITE ?44,"| PRICE"
+23 WRITE ?55,"| TOTAL"
+24 WRITE ?67,"|"
+25 IF ACRREFX'=103&(ACRREFX'=349)&(ACRREFX'=326)&'$DATA(ACRPRT)&'$DATA(ACRPQT)
Begin DoDot:1
+26 WRITE ?68,"CODE"
+27 WRITE ?72,"|CAN NO."
End DoDot:1
+28 IF ACRREFX=103&'$DATA(ACRPQT)
WRITE ?68,"ACCEPTED"
+29 WRITE !,"(A)|"
+30 WRITE ?4," (B) "
+31 WRITE ?34,"| (C)"
+32 WRITE ?41,"|D)"
+33 WRITE ?44,"| (E)"
+34 WRITE ?55,"| (F)"
+35 WRITE ?67,"|"
+36 IF ACRREFX'=103&'$DATA(ACRPRT)
Begin DoDot:1
+37 WRITE ?68,"----"
+38 WRITE ?72,"|-------"
End DoDot:1
+39 IF ACRREFX=103&'$DATA(ACRPQT)
WRITE ?68," (G)"
+40 WRITE !,"---|"
+41 WRITE ?4,"------------------------------"
+42 WRITE ?34,"|------"
+43 WRITE ?41,"|--"
+44 WRITE ?44,"|----------"
+45 WRITE ?55,"|-----------"
+46 WRITE ?67,"|"
+47 IF ACRREFX'=103&(ACRREFX'=349)&(ACRREFX'=326)&'$DATA(ACRPRT)&'$DATA(ACRPQT)
Begin DoDot:1
+48 WRITE ?68,"----"
+49 WRITE ?72,"|-------"
End DoDot:1
+50 IF ACRREFX=103&'$DATA(ACRPQT)
WRITE ?68,"--------"
+51 QUIT
HEADSS4 ;EP;
+1 IF $DATA(ACROUT)
QUIT
+2 WRITE @IOF
+3 WRITE !?10,"DHHS/INDIAN HEALTH SERVICE - TRAVEL ",$SELECT(ACRREFX=130:"EXPENSE ESTIMATE",1:"VOUCHER")
+4 WRITE !?4,"TRAVEL ORDER: ",ACRDOC
+5 WRITE ?40,"TRAVELER: "
+6 NEW ACRX
+7 ;ACR*2.1*3.44
SET ACRX=$PIECE($GET(^ACRDOC(ACRDOCDA,"TO")),U,9)
+8 IF 'ACRX
Begin DoDot:1
+9 WRITE !,"TRAVELER'S NAME MUST BE ENTERED BEFORE YOU PROCEED."
+10 DO PAUSE^ACRFWARN
+11 SET (ACRQUIT,ACROUT)=""
End DoDot:1
QUIT
+12 ;E S ACRX=$P(^VA(200,ACRX,0),U) ;ACR*2.1*19.02 IM16848
+13 ;ACR*2.1*19.02 IM16848
IF '$TEST
SET ACRX=$$NAME2^ACRFUTL1(ACRX)
+14 WRITE ACRX
+15 ;ACR*2.1*14.01 IM12272
WRITE !,"DHHS #: ",$$EXPDN^ACRFUTL(ACRDOCDA)
+16 IF ACRREFX=600
WRITE !,"SCHEDULE OF EXPENSES AND AMOUNTS CLAIMED"
+17 WRITE $$DASH^ACRFMENU
SS41 ;EP;
+1 WRITE !,"DAY"
+2 WRITE ?3,"DATE"
+3 WRITE ?8,"DEPT"
+4 WRITE ?13,"ARRV"
+5 WRITE ?18,"CITY"
+6 WRITE ?26," M & IE"
+7 WRITE ?36,"LODGING"
+8 WRITE ?46,"MILES"
+9 WRITE ?54,"TAXI"
+10 WRITE ?63,"CALL HOM"
+11 WRITE ?72,"OTHER"
+12 WRITE !,"--"
+13 WRITE ?3,"----"
+14 WRITE ?8,"----"
+15 WRITE ?13,"----"
+16 WRITE ?18,"-------"
+17 WRITE ?26,"---------"
+18 WRITE ?36,"---------"
+19 WRITE ?46,"-------"
+20 WRITE ?54,"--------"
+21 WRITE ?63,"--------"
+22 WRITE ?72,"-------"
+23 QUIT
D ;DISPLAY PROCESSOR
+1 SET ACRX=""
+2 FOR Z=X,Y
FOR I=1:1:5
IF $PIECE(Z,U,I)]""
SET ACRX=ACRX_$PIECE(Z,U,I)_" "
+3 IF ACRX=""
QUIT
+4 WRITE !
+5 DO D1
+6 WRITE "-----------------------------"
+7 WRITE ?(80-$LENGTH(ACRY))\2,ACRY
+8 WRITE ?50,"-----------------------------"
+9 DO D1
+10 WRITE !
+11 DO D2
+12 WRITE ?5
+13 NEW J
+14 FOR J=1:1:$LENGTH(ACRX," ")
Begin DoDot:1
+15 SET X=$PIECE(ACRX," ",J)
+16 IF X]""
Begin DoDot:2
+17 IF $X+$LENGTH(X)+1>75
Begin DoDot:3
+18 WRITE ?79
+19 DO D2
+20 WRITE !
+21 DO D2
+22 WRITE ?5
End DoDot:3
+23 WRITE X
+24 WRITE ?$X+1
End DoDot:2
End DoDot:1
+25 IF ACRX]""
WRITE ?79
DO D2
+26 QUIT
D1 WRITE $SELECT(ACRREFX'=600:"|",1:"-")
+1 QUIT
D2 WRITE $SELECT(ACRREFX'=600:"|",1:" ")
+1 QUIT
