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

AFSLRTT3.m

Go to the documentation of this file. 
  1. AFSLRTT3 ;IHS/OIRM/OKCRDC/JDM - WRITE TO 9-TRACK TAPE; [ 10/27/2004   4:21 PM ]
  1.  ;;3.0t1;1166 APPROVALS FOR PAYMENT;**13**;
  1.  ;;ACR*2.1*9 MODIFICATIONS FOR CACHE' COMPLIANCE
  1. FRD ;EP-open unix file, read, and send to 9 track tape
  1.  ;I $D(IO("Q")) S ZTRTN="START^AFSLRTT3",ZTSAVE("AFS*")="",ZTSAVE("IO*")="" D ^%ZTLOAD Q
  1. START S %FN=AFSEXFN,%IN=1 S (AFSLIC,AFSLXZ,AFSLIC1,AFSLTMPX,AFSLBKCT,AFSLGFLG)=0,(AFSLXA,AFSLXC,AFSLXX,AFSLTMXX)=""
  1.  I $D(^AFSLPRM(AFSLTDPM,2)) S X=$P(^(2),U,1)
  1.  E  U IO(0) W !!!,"THERE IS NO 9-TRACK TAPE DEVICE IN THE 1166 PARAMETERS FILE. YOU CANNOT RUN THIS OPTION UNTIL THIS IS CORRECT" Q
  1.  S DIC="^%ZIS(1,"
  1.  S DIC(0)=""
  1.  D ^DIC
  1.  I +Y'>-1 U IO(0) W !!!,"THE 9-TRACK TAPE DEVICE IN THE 1166 PARMETERS FILE, IS NOT IN THE DEVICE FILE. CORRECT THE 1166 PARAMETERS FILE." Q
  1.  S (AFSLTP1,IOP)=X
  1.  S AFSLIO0=IO(0)
  1.  D TAPE^AFSLTT4
  1.  S IOP=AFSLTP1
  1.  S %ZIS("IOPAR")="(""EFUT"":1048:1048:"""")"_":1" D ^%ZIS S AFSLTAP=IO
  1.  I POP D ^XBCLS W !!,"TAPE DRIVE ERROR!" H 3 S AFSLEFLG=1 Q
  1.  U AFSLTAP W *1
  1.  D OPENHFS^AFSTCK1
  1.  ;I $D(AFSERMSG) D ERROR^AFSTCK1 S IO=AFSLTAP D ^%ZISC G FINI^AFSLKILL Q  ; ACR*2.1*13.02 IM13574
  1.  ;S IO=%DEV ; ACR*2.1*13.02 IM13574
  1.  I $D(AFSERMSG) D  G FINI^AFSLKILL               ; ACR*2.1*13.02 IM13574
  1.  .D ERROR^AFSTCK1                                ; ACR*2.1*13.02 IM13574
  1.  .D CLOSE^%ZISH()                                ; ACR*2.1*13.02 IM13574
  1.  F AFSLI=1:1 U IO R X:DTIME D ^AFSLCKZC U AFSLIO0 Q:AFSLNZC=-1!($A(X)=-1)!(AFSLGFLG=1)  S AFSLXX=$E(X,4,84),AFSLXZ=$E(X,1,3),AFSLBKCT=AFSLBKCT+1 D:$A($E(AFSLXZ,1))=66 ITEM I $E(AFSLXZ,1)'["B" D HDTRL
  1.  F AFSLI=1:1 U IO R X:DTIME D ^AFSLCKZC U AFSLIO0 Q:AFSLNZC=-1!($A(X)=-1)!(AFSLGFLG=1)!(X["JV")
  1.  U AFSLDEV W @IOF
  1.  U AFSLTAP W *3
  1.  ;U AFSLIO0 S IO=AFSLTAP D ^%ZISC ; ACR*2.1*13.02 IM13574
  1.  U AFSLIO0 D ^%ZISC ; ACR*2.1*13.02 IM13574
  1.  D EOF^AFSLTT4
  1.  Q
  1. ITEM ;process payment item data
  1.  I AFSLIC1=1 S X=AFSLXA_$J("",895),AFSLXB=AFSLXX D TAPE S AFSLXX=AFSLXB S AFSLIC1=0
  1.  I $E(AFSLXZ,1,3)["B01",AFSLIC>0 S AFSLXB=AFSLXX,X=$J("",12-AFSLIC*55)_" " D TAPE S AFSLXX=AFSLXB,AFSLIC=0
  1.  I $E(AFSLXZ,1,3)["B01" S AFSLXC=AFSLXC_AFSLXX Q  ;ACR*2.1*13.02 IM13574
  1.  I $E(AFSLXZ,1,3)["B02" S X=AFSLXC_"DOC.  NO      AMT PAID   *********** PAID FOR *********"_$J("",55),AFSLXB=AFSLXX,AFSLXC="" D TAPE S AFSLXX=AFSLXB
  1.  S AFSLIC=AFSLIC+1
  1.  S X=AFSLXX D TAPE
  1.  Q
  1. HDTRL ;
  1.  I $E(AFSLXZ,1)["A" S AFSLIC1=1,AFSLXA=AFSLXA_AFSLXX Q
  1.  I $E(AFSLXZ,1)["C" S AFSLXB=AFSLXX,X=$S(AFSLIC>0:$J("",12-AFSLIC*55)_" ",1:"") D TAPE S AFSLXX=AFSLXB
  1.  I $E(AFSLXZ,1)'["A" S X=AFSLXX_$J("",1005) D TAPE
  1.  Q
  1. TAPE ;write to tape
  1.  S AFSLTMPX=X,AFSLTMXX=AFSLTMXX_X
  1.  I $L(AFSLTMXX)>1047 D RPT S X=AFSLTMPX,AFSLTMXX=""
  1.  U AFSLTAP W X
  1.  S (AFSLXX,X)=""
  1.  Q
  1. RPT ;module to generate report containing all records included on treasury tape
  1.  S X=AFSLTMXX
  1.  Q:"A&C"[$E(X,43)
  1.  I "D"[$E(X,43) D TOTS Q
  1.  U AFSLDEV
  1.  I '$D(AFSLLCT) D HDR
  1.  I AFSLLCT>(AFSLDSL-17) D HDR
  1. SHDR ;Vendor name,address,record total,ein #
  1.  W $E(X,44,78),?40,$E(X,79,113) ;VENDOR NAME AND 1ST LINE OF ADDRESS
  1.  S AFSLST=$S($E(X,179,208)[$E(AFSLSP,1,30):0,1:"     "_$E(X,179,208))
  1.  I AFSLST=0 S AFSLST=$S($E(X,149,178)[$E(AFSLSP,1,30):0,1:"     "_$E(X,149,178))
  1.  I AFSLST=0 S AFSLST=$E(X,114,148)
  1.  W ?80,AFSLST ;VENDOR CITY,STATE,AND ZIP
  1.  S AFSLWTOT=X,X=$E(AFSLWTOT,24,32)/100,X2="2$" D COMMA^%DTC
  1.  W ?110,X S X=AFSLWTOT,AFSLWTOT=0 ;RECORD TOTAL AMOUNT
  1.  W !!,"EIN #",?8,$E(X,12,23),?22,$E(X,278,332)
  1.  W !! S AFSLLCT=AFSLLCT+4
  1. WITEM ;item information for each record
  1.  I $E(X,388,442)'[AFSLSP W !,?22,$E(X,388,442) S AFSLLCT=AFSLLCT+1
  1.  I $E(X,443,497)'[AFSLSP W !,?22,$E(X,443,497) S AFSLLCT=AFSLLCT+1
  1.  I $E(X,498,552)'[AFSLSP W !,?22,$E(X,498,552) S AFSLLCT=AFSLLCT+1
  1.  I $E(X,553,607)'[AFSLSP W !,?22,$E(X,553,607) S AFSLLCT=AFSLLCT+1
  1.  I $E(X,608,662)'[AFSLSP W !,?22,$E(X,608,662) S AFSLLCT=AFSLLCT+1
  1.  I $E(X,663,717)'[AFSLSP W !,?22,$E(X,663,717) S AFSLLCT=AFSLLCT+1
  1.  I $E(X,718,772)'[AFSLSP W !,?22,$E(X,718,772) S AFSLLCT=AFSLLCT+1
  1.  I $E(X,773,827)'[AFSLSP W !,?22,$E(X,773,827) S AFSLLCT=AFSLLCT+1
  1.  I $E(X,828,882)'[AFSLSP W !,?22,$E(X,828,882) S AFSLLCT=AFSLLCT+1
  1.  I $E(X,883,937)'[AFSLSP W !,?22,$E(X,883,937) S AFSLLCT=AFSLLCT+1
  1.  I $E(X,938,992)'[AFSLSP W !,?22,$E(X,938,992) S AFSLLCT=AFSLLCT+1
  1.  I $E(X,993,1047)'[AFSLSP W !,?22,$E(X,993,1047) S AFSLLCT=AFSLLCT+1
  1.  W !! S AFSLLCT=AFSLLCT+2
  1.  Q
  1. HDR ;header information
  1.  W @IOF
  1.  S AFSLLCT=0 S:'$D(AFSLSP) AFSLSP="                                                       "
  1.  I '$D(AFSLRDT) S Y=DT X ^DD("DD") S AFSLRDT=Y
  1.  W AFSLRDT,?18,"********************",?49,"INDIAN HEALTH SERVICE"
  1.  W ?89,"********************",?109,"PAGE " W $S($D(AFSLPG):AFSLPG,1:1)
  1.  S AFSLPG=$S($D(AFSLPG):AFSLPG+1,1:2)
  1.  W !!,?20,"TREASURY TAPE (1166) GENERATION PROGRAM",?92,"SCHEDULE NUMBER"
  1.  W ?112,$E(X,1,10),!! S AFSLLCT=AFSLLCT+4
  1.  Q
  1. TOTS ;
  1.  U AFSLDEV
  1.  S AFSLCDT=X,X=$E(X,31,42)/100,X1="2$" D COMMA^%DTC S AFSLDCT=X,X=AFSLCDT
  1.  W "RECORD TOTAL: ",+$E(X,24,30),?50,"TOTAL AMOUNT: ",AFSLDCT
  1.  Q
  1. TAPSTOP ;
  1.  U AFSLIO0 W !!!,"VENDOR: ",$E(AFSLXX,46,84),?50,"EIN: ",$E(AFSLXX,15,26),?65,"BAD FORMAT"
  1.  Q