source: FOIAVistA/trunk/r/INCOMPLETE_RECORDS_TRACKING-DGJ/DGJBGJ.m@ 702

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

initial load of FOIAVistA 6/30/08 version

File size: 5.0 KB
Line 
1DGJBGJ ;ALB/MAF - IRT BACKGROUND JOB/SHORT FORM LIST - MAY 3 1993
2 ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
3EN N DGJBG,DGJED
4 D DAT
5 I Y=-1 G QUIT
6 ;D START Q ;Line for testing
7 S ZTIO="",ZTRTN="START^DGJBGJ",ZTDESC="IRT Background Job to Initialize admissions with standard deficiencies"
8 F X="DGJBG","DGJED" S ZTSAVE(X)=""
9 K ZTSK D ^%ZTLOAD W:$D(ZTSK) " (TASK: #",ZTSK,")"
10 Q
11AUTO ;Nightly Job Entry Point
12 S X1=DT,X2=-2 D C^%DTC
13 S (DGJFLAG,DGJFLG)=0
14 S DGJBG=X,DGJED=X+.2359 D SHORT
15 S X1=DT,X2=-1 D C^%DTC
16 S DGJBG=X,DGJED=X+.2359 D START
17 Q
18SHORT S DGJX=0,DGJDEF=0,DGJDA=0
19 F S DGJBG=$O(^DGPM("B",DGJBG)) Q:DGJBG']""!(DGJBG>DGJED) F S DGJDA=$O(^DGPM("B",DGJBG,DGJDA)) Q:'DGJDA I $D(^DGPM(DGJDA,0)),$P(^DGPM(DGJDA,0),"^",2)=1,$P(^DGPM(DGJDA,0),"^",17) D SET,CK
20 Q
21CK S DGJFLAG=0,X2=$P($G(^DGPM(+DGJCA,0)),"^",1),X1=$P($G(^DGPM(+DGJDIS,0)),"^",1) Q:X1=X2 D ^%DTC I X<2 D SETUP S DGJFLAG=1
22 Q
23SETSTR(S,V,X,L) ; -- insert text(S) into variable(V)
24 ; S := string
25 ; V := destination
26 ; X := @ col X
27 ; L := # of chars
28 ;
29 Q $E(V_$J("",X-1),1,X-1)_$E(S_$J("",L),1,L)_$E(V,X+L,999)
30SETUP S DFN=$P(DGJTND,"^",3) D PID^VADPT6 S VAIP("D")=$P(^DGPM(DGJDIS,0),"^",1)-.000001 D IN5^VADPT S X=+VAIP(5) S DGJDIV=$S($D(^DIC(42,+X,0)):$P(^DIC(42,X,0),"^",11),1:"")
31 I $D(^DGPM(+DGJDIS,0)) S DGJTTYP=$P(^(0),"^",4) S DGJTTYP=$S($D(^DG(405.1,+DGJTTYP,0)):$E($P(^(0),"^",1),1,20),1:"")
32 S X=""
33 S X=$$SETSTR($E($P(^DPT($P(DGJTND,"^",3),0),"^",1),1,15),X,1,15)
34 S X=$$SETSTR(VA("BID"),X,19,5)
35 S X=$$SETSTR($$FTIME^VALM1($P($G(^DGPM(DGJCA,0)),"^",1)),X,28,18)
36 S X=$$SETSTR(DGJTTYP,X,50,15)
37 S X=$$SETSTR($S($G(^DG(40.8,+DGJDIV,0))]"":$P(^DG(40.8,+DGJDIV,0),"^",1),1:""),X,69,11)
38 S ^TMP("VAS",$J,$S($G(^DG(40.8,+DGJDIV,0))]"":$P(^DG(40.8,+DGJDIV,0),"^",1),1:""),$P($G(^DGPM(DGJCA,0)),"^"),DGJCA,0)=X
39 Q
40SET S (DGJTND,DGJCA,DGJDIS)="" S DGJTND=$G(^DGPM(DGJDA,0)),DGJCA=$P(DGJTND,"^",14),DGJDIS=$P(DGJTND,"^",17) S:DGJDIS']"" DGJFLG=1 Q
41START S (DGJFLAG,DGJFLG)=0 D NOW^%DTC S DGJDATE=% S DGJRUN=DGJBG K DGJERR
42 S DGJX=0,DGJDEF=0,DGJDA=0
43 F S DGJDEF=$O(^VAS(393.3,DGJDEF)) Q:DGJDEF']"" S DGJNODE=$G(^VAS(393.3,DGJDEF,0)) I $P(DGJNODE,"^",8)=1,DGJDEF'=$O(^VAS(393.3,"B","DISCHARGE SUMMARY",0)) S DGJAR(DGJDEF)=""
44 F S DGJBG=$O(^DGPM("B",DGJBG)) Q:DGJBG']""!(DGJBG>DGJED) F S DGJDA=$O(^DGPM("B",DGJBG,DGJDA)) Q:'DGJDA I $D(^DGPM(DGJDA,0)),$P(^DGPM(DGJDA,0),"^",2)=1 D SET D:DGJDIS]"" CK D:DGJFLAG DIV I DGJFLG,'$D(^DGPM(+DGJCA,"IRT")) D UP,FL
45 S DIE="^DG(43,",DA=1,DR="401///"_DGJDATE D ^DIE K DA,DR
46 D MSG^DGJBGJ1
47 I $D(DGJERR) D ERRMSG^DGJBGJ1
48QUIT K %,%DT,DFN,DGJAR,DGJBG,DGJCA,DGJDA,DGJDATE,DGJDEF,DGJED,DGJEVT,DGJFDE,DGJNODE,DGJT,DGJT10,DGJT9,DGJTBEG,DGJTBG,DGJTDEL,DGJTDIV,DGJED,DGJTND,DGJTPR,DGJTSP,DGJTST,DGJTSV,DGJTWD,DGJTWD1,DGJX,DGJY,DIC,DIE,DLAYGO,DR,VAIP,X,X1,X2,Y
49 K DGJB,DGJDIS,DGJDIV,DGJI,DGJMSG,DGJERR,DGJERROR,DGJRUN,DGJSTD,DGJTTYP,VA,DGJBG,DGJDA,DGJDEF,DGJED,DGJFLAG,DGJFLG,DGJTCNT,DGJX,X,DGJTWARD,VAERR,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,^TMP("VAS",$J) Q
50UP S (DGJFLG,DGJERROR)=0,DFN=$P(DGJTND,"^",3) Q:DFN']"" S VAIP("D")=$S(DGJDIS]""&($D(^DGPM(+DGJDIS,0))):$P(^DGPM(DGJDIS,0),"^",1)-.000001,1:"L")
51 D IN5^VADPT
52 I +VAIP(5)']0 S DGJERR("ERR1",DFN,$P(DGJTND,"^",1))="",DGJERROR=1 Q
53 S DGJTWARD=+VAIP(5)
54 S DGJTWD=$S($D(^DIC(42,DGJTWARD,0)):^DIC(42,DGJTWARD,44),1:"")
55 S DGJTSV=$S(DGJTWARD]"":$P(^DIC(42,+DGJTWARD,0),"^",3),1:"")
56 S DGJTSP=+VAIP(8)
57 S:DGJTSV="" DGJTSV=0 S DGJTSV=$S(DGJTSV=0:12,$D(^DG(393.1,"AC",DGJTSV)):$O(^(DGJTSV,0)),1:"")
58 S DGJEVT=+DGJTND
59 S DGJTDIV=$S($D(^DIC(42,DGJTWARD,0)):$P(^DIC(42,DGJTWARD,0),"^",11),1:"")
60 S DGJTDEL=$G(^DG(40.8,+DGJTDIV,"DT"))
61 S DGJT=$O(^DGPM("ATS",DFN,DGJCA,0)),DGJT=$O(^(+DGJT,0)),DGJT=$O(^(+DGJT,0)),DGJT=$S($D(^DGPM(+DGJT,0)):^(0),1:"") ;last TS mvt
62 S DGJX=8,DGJY=2 D DOC S DGJT9=$S(X]"":X,1:"@"),X=""
63 S DGJT10="" I $P(DGJTDEL,"^",3)!('$P(DGJTDEL,"^",3)&($P(DGJTDEL,"^",10)="A")) S DGJX=19,DGJY=4 D DOC S DGJT10=$S(X]"":X,1:"@")
64 S DGJTPR=DGJT9
65 Q
66FL I DGJERROR=1 Q
67 S DGJFDE=0
68 F S DGJFDE=$O(DGJAR(DGJFDE)) Q:DGJFDE']"" D FL1
69 Q
70FL1 S X=DFN,DIC="^VAS(393,",DIC(0)="L",DLAYGO=393 K DD,DO D FILE^DICN
71 S DGJTST=$O(^DG(393.2,"B","INCOMPLETE",0))
72 I Y>0 S DIE=DIC,DA=+Y
73 I Y>0 S DR=".02////"_DGJFDE_";.03////"_DGJEVT_";.04////"_DGJCA_";.05////"_DGJTWD_";.06////"_DGJTDIV_";.07////"_DGJTSP_";.08////"_DGJTSV_";.09////"_DGJT9_";.1////"_DGJT10_";.11////"_DGJTST_";.12////"_DGJT9
74 I Y>0 D ^DIE K DA,DR S DIE="^DGPM(",DA=DGJCA,DR="60.01///"_DGJDATE D ^DIE K DA,DR
75 Q
76DIV S (DGJFLG,DGJFLAG)=0 I $D(^DG(40.8,DGJDIV,"DT")) S DGJSTD=$P(^DG(40.8,DGJDIV,"DT"),"^",11) I DGJSTD=1 S DGJFLG=1
77 Q
78DOC ;provider resp.
79 S X=$P(DGJTDEL,"^",DGJY)
80 S X=$S(X="A":$P(DGJT,"^",19),X="N":"",1:$P(DGJT,"^",8))
81 Q
82DAT ;DATE RANGE
83BEG W ! S %DT="AEX",%DT("A")="Select Beginning Date: " D ^%DT S DGJBG=Y S:X="^"!(X="") Y=-1 Q:Y=-1 D NOW^%DTC I DGJBG>$P(%,".",1) W !!,"Dates in the future are not allowed!" G BEG
84END W ! S %DT("A")="Select Ending Date : " D ^%DT S:X="^"!(X="") Y=-1 Q:Y=-1 I Y<1 D HELP^%DTC G END
85 S DGJED=Y_.2359
86 I DGJED\1<DGJBG W !!?5,"The ending date cannot be before the beginning date" G END
87 Q
Note: See TracBrowser for help on using the repository browser.