Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACRFFS

ACRFFS.m

Go to the documentation of this file. 
  1. ACRFFS ;IHS/OIRM/DSD/THL,AEF - FEDSTRIP PRINT FORMAT; [ 09/23/2005   9:44 AM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
  1.  ;;ROUTINE TO PRINT FEDSTRIP ORDERS
  1. EN K ACRPAGE,ACRQUIT
  1.  D EN1
  1. EXIT K ACR,ACRQUIT,ACROUT,ACRFINDA,ACRFINRQ,ACRFL,ACRFLDA,ACRFLRQ,ACRFUND,ACRJDATE,ACRPAGE,ACRRQD,ACRSN,ACRSSRQ,ACRRTID,ACRPRIOR,ACRRDATE,ACRPOFON
  1.  Q
  1. EN1 ;
  1.  D DOC
  1.  Q:$D(ACRQUIT)
  1.  S (ACRSSDA,ACRSSTOT)=0
  1.  F ACRI=1:1 S ACRSSDA=$O(^ACRSS("J",ACRDOCDA,ACRSSDA)) Q:'ACRSSDA  S ACRSSTOT=ACRSSTOT+$P(^ACRSS(ACRSSDA,"DT"),U,4)
  1.  D HEAD
  1.  Q:$D(ACRQUIT)
  1.  D SS
  1.  Q
  1. SS S ACRSSDA=0
  1.  F ACRI=1:1 S ACRSSDA=$O(^ACRSS("J",ACRDOCDA,ACRSSDA)) Q:'ACRSSDA  D S1 Q:$D(ACRQUIT)!$D(ACROUT)
  1.  S ACRREFX=103
  1.  I $E(IOST,1,2)="P-",IOSL-20<$Y W @IOF D HEAD Q:$D(ACRQUIT)
  1.  D ^ACRFPAPV
  1.  D ^ACRFPSS
  1.  Q
  1. S1 D SETSS^ACRFSSA
  1.  S ACRNSN=$P(ACRSSNMS,U,2)
  1.  S ACRSSDC1=$P(ACRSSDSC,U)
  1.  S:ACRNSN="" ACRNSN=ACRSSDC1
  1.  S:ACRNSN'?4N1"-"2UN1"-"3N1"-"4N.E ACRNSN="9999-99-999-9999"
  1.  S ACRNSN=$TR(ACRNSN,"-"," ")
  1.  S ACRSN=$P(ACRSS0,U,14)
  1.  F ACRI=1:1:4-($L(ACRRQD)-1) S ACRRQD="0"_ACRRQD
  1.  F ACRI=1:1:3-($L(ACRSN)-1) S ACRSN="0"_ACRSN
  1.  D L4
  1.  I IOSL-5<$Y,$O(^ACRSS("J",ACRDOCDA,ACRSSDA)) D PAUSE^ACRFWARN W @IOF Q
  1.  I '$O(^ACRSS("J",ACRDOCDA,ACRSSDA)) D PAUSE^ACRFWARN Q
  1.  I $E(IOST,1,2)="P-",IOSL-5<$Y,$O(^ACRSS("J",ACRDOCDA,ACRSSDA)) W @IOF D HEAD
  1.  Q
  1. DOC D SETDOC^ACRFEA1
  1. DOC1 ;EP;TO SET FEDSTRIP VARIABLES
  1.  K ACRFLDA,ACRFINDA
  1.  S ACRFS=$G(^ACRDOC(ACRDOCDA,3))
  1.  S ACRDOCDT=$G(^ACRDOC(ACRDOCDA,"DT"))
  1.  N ACRI
  1.  F ACRI=11:1:15 I $P(ACRFS,U,ACRI)="" S ACRQUIT="" Q
  1.  S ACRFLDA=$P(ACRFS,U,13)
  1.  S ACRRTID=$P(ACRFS,U,11)
  1.  S ACRRTID=$P($G(^ACRFSRI(+ACRRTID,0)),U)
  1.  S ACRFSID=$P(ACRFS,U,12)
  1.  S ACRFSID=$P($G(^ACRFSDI(+ACRFSID,0)),U)
  1.  S ACRFINDA=$P(ACRFS,U,14)
  1.  S ACRSIG=$P(ACRFS,U,15),X=$P(ACRDOCDT,U,4)
  1.  S ACRPRIOR=$S(X="E":"03",X="P":"08",1:15)
  1.  S X=+$G(^ACRDOC(ACRDOCDA,"PA"))
  1.  ;S X=$S(X:$P(^VA(200,X,0),U),1:"")  ;ACR*2.1*19.02 IM16848
  1.  S X=$S(X:$$NAME2^ACRFUTL1(X),1:"")  ;ACR*2.1*19.02 IM16848
  1.  S ACRPURA=$P($P(X,",",2)," ")_" "_$P(X,",")
  1.  S ACRLBDA=$P(ACRDOC0,U,6)
  1.  S ACRDPTDA=$P(^ACRLOCB(ACRLBDA,0),U,5)
  1.  S:'ACRFLDA ACRFLDA=$P(^ACRDEPT(ACRDPTDA,0),U,2)
  1.  S ACRFL=$G(^ACRFSCD(+ACRFLDA,0))
  1.  S ACRFLRQ=$P(ACRFL,U,2)
  1.  S ACRFUND=$P(ACRFL,U,3)
  1.  S ACRPODA=$P(ACRDOC0,U,8)
  1.  S ACRPOFON=$P(^ACRPO(ACRPODA,0),U,9)
  1.  S:'ACRFINDA ACRFINDA=$S($P(ACRFL,U,5):$P(ACRFL,U,5),1:ACRFLDA)
  1.  S ACRFL=$G(^ACRFSCD(+ACRFINDA,0))
  1.  S ACRFINRQ=$P(ACRFL,U,2)
  1.  S ACRRDATE=$P(ACRDOCPO,U,12)
  1.  I ACRRDATE D
  1.  .S X=$E(DT,1,3)_"0101"
  1.  .D H^%DTC
  1.  .S ACRFY=%H
  1.  .S X=ACRRDATE
  1.  .D H^%DTC
  1.  .S X=%H+1-ACRFY
  1.  .S X=$E("000",1,3-$L(X))_X
  1.  .S ACRRDATE=X
  1.  S X2=$E($P(ACRDOC0,U,3),1,3)_"0101"
  1.  S X1=$P(ACRDOC0,U,3)+1
  1.  D ^%DTC
  1.  S ACRJDATE=$P(ACRDOC0,U,26)
  1.  Q
  1.  S ACRPAGE=$S('$D(ACRPAGE):1,1:ACRPAGE+1)
  1.  W !
  1.  I $E($G(IOST),1,2)="C-" W "ARMS REF: ",$P($G(ACRDOC0),U,6),"/",ACRDOCDA
  1.  W ?16,"DOCUMENT IDENTIFICATION"
  1.  W ?50,"PAGE  ",ACRPAGE
  1.  W ?70,"STANDARD FORM 344"
  1.  D L1
  1.  W !,"1.   |2.   |3. |DOCUMENT NUMBER |13.|14-15.  |16.|17.  |18.  |19.  |20.  |21.  |"
  1.  W:ACRPAGE=1 ?$X+3,"For Questions concerning this order contact:"
  1.  W !,"     |     | M |9-10.    |11.   | D | SUPPLE | S |     |DIST |     | PRI | RQD |"
  1.  W:ACRPAGE=1 ?$X+3,ACRPURA
  1.  W !," DOC.| ROUT| & | REQUISI |      | E | MENTARY| I |     |RIBU |PRO  | OR  | DEL |"
  1.  W:ACRPAGE=1 ?$X+3,ACRPOFON
  1.  W !,"IDEN | IDEN| S | TIONER  | DATE | M | ADDRESS| G |FUND |TION |JECT | ITY |DATE |"
  1.  W !," 1-3 | 4-6 | 7 | 30-35   | 36-39| 44| 45-50  | 51|52-53|54-56|57-59|60-61|62-64|"
  1.  I ACRPAGE=1 D
  1.  .W ?$X+3,"REQ. #: ",$P(^ACRDOC(ACRDOCDA,0),U)
  1.  .W ?$X+3,"PO #: ",$P(^ACRDOC(ACRDOCDA,0),U,2)
  1.  D L2
  1.  W !," "
  1.  W $S(ACRFSID]"":ACRFSID,1:"***")," | "
  1.  W $S(ACRRTID]"":ACRRTID,1:"***")," | A | "
  1.  W $S(ACRFLRQ]"":ACRFLRQ,1:"******"),"  | "
  1.  W $S(ACRJDATE]"":ACRJDATE,1:"****")," |   | "
  1.  W $S(ACRFINRQ]"":ACRFINRQ,1:"******")," | "
  1.  W $S(ACRSIG]"":ACRSIG,1:"*")," | "
  1.  W $S(ACRFUND]"":ACRFUND,1:"**"),"  |     |     | "
  1.  W $S(ACRPRIOR]"":ACRPRIOR,1:"**"),"  | "
  1.  W $S(ACRRDATE]"":ACRRDATE,1:"***")," |"
  1.  W:ACRPAGE=1 ?$X+3,"TOTAL:  ",$FN(ACRSSTOT,"P,",2)
  1.  D L1
  1.  D PAUSE^ACRFWARN
  1.  Q:$D(ACRQUIT)
  1.  W !?30,"REQUISITION DATA"
  1.  D L1
  1.  W !,"     STOCK NUMBER   |6.   |7.   |8.     |12.  |14-15. |16.|18.  |19.  |22.  |"
  1.  W !,"--------------------|     |UNIT |       | SER |SUPPLE-| S |DIST |     |     |"
  1.  W !,"4.    |5.           | ADD-| OF  | QUAN- | IAL |MENTARY| I |RIBU |PRO- | AD- |"
  1.  W !," FSC  |    NSN      | TNL |ISSUE| TITY  | NO. |ADDRESS| G |TION |JECT |VICE |"
  1.  D L3
  1.  W !," 8-11 |    12-20    |21-22|23-24| 25-29 |40-43| 45-50 | 51|54-56|57-59|65-66|"
  1.  D L1
  1.  Q
  1. L W $$DASH^ACRFMENU
  1.  Q
  1. L1 W $$DASH^ACRFMENU(132)
  1.  Q
  1. L2 W !,"-----|-----|---|---------|------|---|--------|---|-----|-----|-----|-----|-----|"
  1.  Q
  1. L4 W !?1,$E(ACRNSN,1,4)," | ",$E(ACRNSN,6,17)
  1.  W ?20,"|     | ",$S(ACRUI]"":ACRUI,1:"**"),"  | ",ACRRQD," | ",ACRSN,"|       |   |     |     |     |",$J(ACRUC,9)
  1.  W ?$X+1,$E(ACRSSDC1,1,28)
  1.  W ?120,$J($FN(ACRRQD*ACRUC,"P",2),10)
  1.  I $P(ACRSSDT,U,22)]"" W !?81,$P(ACRSSDT,U,22)
  1. L3 W !,"------|-------------|-----|-----|-------|-----|-------|---|-----|-----|-----|----------------------------------------------------"
  1.  Q