- 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
