source: WorldVistAEHR/trunk/r/PAID-PRS/PRSDPROC.m@ 1801

Last change on this file since 1801 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.3 KB
RevLine 
[613]1PRSDPROC ;SC/GWB-PAID DOWNLOAD PRS GLOBAL PROCESSOR ;5/6/93 13:12
2 ;;4.0;PAID;**109**;Sep 21, 1995;Build 5
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 I '$D(^XTMP("PRS","TMP")) W !!,"There is no unprocessed PAID download data." R !!,"Press return to continue ",A:DTIME K A Q
5TASK S ANS=""
6 S %=0 W !!,"Do you want to task this job" D YN^DICN
7 I %=-1 G EXIT
8 I %=0 W !,?4,*7,"ANSWER 'YES' OR 'NO':" G TASK
9 I %=1 S ZTRTN="PROC^PRSDPROC",ZTIO="",ZTDESC="PAID DOWNLOAD PROCESSOR" D ^%ZTLOAD Q
10 S:%=2 ANS="N"
11PROC S DATE="",SUB="TMP" D NOW^%DTC S TIME=%
12 F L1=1:1 S DATE=$O(^XTMP("PRS",SUB,DATE)) Q:DATE="" S TYPE="" F L2=1:1 S TYPE=$O(^XTMP("PRS",SUB,DATE,TYPE)) Q:TYPE="" S STA="" F L3=1:1 S STA=$O(^XTMP("PRS",SUB,DATE,TYPE,STA)) Q:STA="" S ECNT=0 D MSG,START^PRSDSERV,^PRSDSTAT
13EXIT D EXIT^PRSDSERV
14 I $D(ZTQUEUED) S ZTREQ="@"
15 K ANS,L1,L2,L3,TIME
16 Q
17ERR I '$D(^XTMP("PRS","ERR")) W !!,"There are no unprocessed PAID download errors." R !!,"Press return to continue ",A:DTIME K A Q
18 S DATE="",SUB="ERR"
19 F L1=1:1 S DATE=$O(^XTMP("PRS",SUB,DATE)) Q:DATE="" S TYPE="" F L2=1:1 S TYPE=$O(^XTMP("PRS",SUB,DATE,TYPE)) Q:TYPE="" S STA="" F L3=1:1 S STA=$O(^XTMP("PRS",SUB,DATE,TYPE,STA)) Q:STA="" S ECNT=0,ANS="" D MSG,START^PRSDSERV
20 G EXIT
21MSG S MTYPE=$S(TYPE="I":"Initial",TYPE="E":"Edit & Update",TYPE="P":"Payrun",TYPE="T":"Transfer",1:"")
22 Q:'$D(ANS)
23 W !!,"Processing ",MTYPE," data for station ",STA," for ",$E(DATE,5,6),"/",$E(DATE,7,8),"/",$E(DATE,3,4)," "
24 Q
25PRSD ;R !,"SSN: ",SSN:DTIME G:(SSN["^")!(SSN="") PRSDEX
26 ;R !,"START WITH MSG #: ",MSGNUM:DTIME G:(MSGNUM["^")!(MSGNUM="") PRSDEX
27 ;S BSKTIEN=0,BSKTIEN=$O(^XMB(3.7,.5,2,"B","S.PRSD",BSKTIEN))
28 ;S XMZ=MSGNUM-1 F S XMZ=$O(^XMB(3.7,.5,2,BSKTIEN,1,XMZ)) Q:XMZ'>0 W "." S XMPOS=0 F D REC^XMS3 Q:XMER<0 D
29 ;.I XMRG["****PDH" S TYPE=XMRG
30 ;.I XMRG[SSN W !!,XMZ_"-"_XMPOS_TYPE,!!,XMRG
31PRSDEX ;K SSN,MSGNUM,BSKTIEN,XMZ,TYPE,XMRG,XMER,XMPOS
32 ;Q
33XMB R !,"APPLICATION: ",APP:DTIME G:(APP["^")!(APP="") XMBEX
34 R !,"ROUTING IND: ",RI:DTIME G:(RI["^")!(RI="") XMBEX
35 R !,"DAY NUMBER: ",DN:DTIME G:(DN["^")!(DN="") XMBEX
36 R !,"SSN: ",SSN:DTIME G:(SSN["^")!(SSN="") XMBEX
37 S SUB=APP_"/"_RI_" #"_DN,TYPE=""
38 F S SUB=$O(^XMB(3.9,"B",SUB)) Q:SUB'[APP W "." S XMZ=0,XMZ=$O(^XMB(3.9,"B",SUB,XMZ)) S XMPOS=0 F D REC^XMS3 Q:XMER<0 D
39 .I XMRG["****PDH" S TYPE=XMRG
40 .I XMRG[SSN W !!,XMZ_"-"_XMPOS_TYPE,!!,XMRG
41XMBEX K APP,RI,DN,SSN,SUB,TYPE,XMZ,XMRG,XMER,XMPOS
42 Q
43FIX R !,"IEN#1: ",IEN1:DTIME G:(IEN1["^")!(IEN1="") FIXEX
44 R !,"IEN#2: ",IEN2:DTIME G:(IEN2["^")!(IEN2="") FIXEX
45 S PPIEN=0 F S PPIEN=$O(^PRST(459,PPIEN)) Q:PPIEN'>0 I $D(^PRST(459,PPIEN,"P",IEN1)) D
46 .W !,"PAY PERIOD ",^PRST(459,PPIEN,0)
47 .S %X="^PRST(459,PPIEN,""P"","_IEN1_","
48 .S %Y="^PRST(459,PPIEN,""P"","_IEN2_","
49 .I '$D(^PRST(459,PPIEN,"P",IEN2)) D %XY^%RCR S $P(^PRST(459,PPIEN,"P",IEN2,0),"^",1)=IEN2,^PRST(459,PPIEN,"P","B",IEN2,IEN2)=""
50 .K ^PRST(459,PPIEN,"P",IEN1),^PRST(459,PPIEN,"P","B",IEN1,IEN1)
51 S PPIEN=0 F S PPIEN=$O(^PRST(455,PPIEN)) Q:PPIEN'>0 I $D(^PRST(455,PPIEN,1,IEN1)) D
52 .W !,"PAY PERIOD ",$P(^PRST(455,PPIEN,0),"^",1)
53 .S %X="^PRST(455,PPIEN,1,"_IEN1_","
54 .S %Y="^PRST(455,PPIEN,1,"_IEN2_","
55 .I '$D(^PRST(455,PPIEN,1,IEN2)) D %XY^%RCR S $P(^PRST(455,PPIEN,1,IEN2,0),"^",1)=IEN2,^PRST(455,PPIEN,1,"B",IEN2,IEN2)=""
56 .K ^PRST(455,PPIEN,1,IEN1),^PRST(455,PPIEN,1,"B",IEN1,IEN1)
57 D FIXEX G FIX
58FIXEX K IEN1,IEN2,PPIEN,%X,%Y
59 Q
Note: See TracBrowser for help on using the repository browser.