88 lines
5.0 KiB
Mathematica
88 lines
5.0 KiB
Mathematica
DGJBGJ ;ALB/MAF - IRT BACKGROUND JOB/SHORT FORM LIST - MAY 3 1993
|
|
;;1.0;Incomplete Records Tracking;;Jun 25, 2001
|
|
EN N DGJBG,DGJED
|
|
D DAT
|
|
I Y=-1 G QUIT
|
|
;D START Q ;Line for testing
|
|
S ZTIO="",ZTRTN="START^DGJBGJ",ZTDESC="IRT Background Job to Initialize admissions with standard deficiencies"
|
|
F X="DGJBG","DGJED" S ZTSAVE(X)=""
|
|
K ZTSK D ^%ZTLOAD W:$D(ZTSK) " (TASK: #",ZTSK,")"
|
|
Q
|
|
AUTO ;Nightly Job Entry Point
|
|
S X1=DT,X2=-2 D C^%DTC
|
|
S (DGJFLAG,DGJFLG)=0
|
|
S DGJBG=X,DGJED=X+.2359 D SHORT
|
|
S X1=DT,X2=-1 D C^%DTC
|
|
S DGJBG=X,DGJED=X+.2359 D START
|
|
Q
|
|
SHORT S DGJX=0,DGJDEF=0,DGJDA=0
|
|
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
|
|
Q
|
|
CK 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
|
|
Q
|
|
SETSTR(S,V,X,L) ; -- insert text(S) into variable(V)
|
|
; S := string
|
|
; V := destination
|
|
; X := @ col X
|
|
; L := # of chars
|
|
;
|
|
Q $E(V_$J("",X-1),1,X-1)_$E(S_$J("",L),1,L)_$E(V,X+L,999)
|
|
SETUP 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:"")
|
|
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:"")
|
|
S X=""
|
|
S X=$$SETSTR($E($P(^DPT($P(DGJTND,"^",3),0),"^",1),1,15),X,1,15)
|
|
S X=$$SETSTR(VA("BID"),X,19,5)
|
|
S X=$$SETSTR($$FTIME^VALM1($P($G(^DGPM(DGJCA,0)),"^",1)),X,28,18)
|
|
S X=$$SETSTR(DGJTTYP,X,50,15)
|
|
S X=$$SETSTR($S($G(^DG(40.8,+DGJDIV,0))]"":$P(^DG(40.8,+DGJDIV,0),"^",1),1:""),X,69,11)
|
|
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
|
|
Q
|
|
SET S (DGJTND,DGJCA,DGJDIS)="" S DGJTND=$G(^DGPM(DGJDA,0)),DGJCA=$P(DGJTND,"^",14),DGJDIS=$P(DGJTND,"^",17) S:DGJDIS']"" DGJFLG=1 Q
|
|
START S (DGJFLAG,DGJFLG)=0 D NOW^%DTC S DGJDATE=% S DGJRUN=DGJBG K DGJERR
|
|
S DGJX=0,DGJDEF=0,DGJDA=0
|
|
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)=""
|
|
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
|
|
S DIE="^DG(43,",DA=1,DR="401///"_DGJDATE D ^DIE K DA,DR
|
|
D MSG^DGJBGJ1
|
|
I $D(DGJERR) D ERRMSG^DGJBGJ1
|
|
QUIT 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
|
|
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
|
|
UP 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")
|
|
D IN5^VADPT
|
|
I +VAIP(5)']0 S DGJERR("ERR1",DFN,$P(DGJTND,"^",1))="",DGJERROR=1 Q
|
|
S DGJTWARD=+VAIP(5)
|
|
S DGJTWD=$S($D(^DIC(42,DGJTWARD,0)):^DIC(42,DGJTWARD,44),1:"")
|
|
S DGJTSV=$S(DGJTWARD]"":$P(^DIC(42,+DGJTWARD,0),"^",3),1:"")
|
|
S DGJTSP=+VAIP(8)
|
|
S:DGJTSV="" DGJTSV=0 S DGJTSV=$S(DGJTSV=0:12,$D(^DG(393.1,"AC",DGJTSV)):$O(^(DGJTSV,0)),1:"")
|
|
S DGJEVT=+DGJTND
|
|
S DGJTDIV=$S($D(^DIC(42,DGJTWARD,0)):$P(^DIC(42,DGJTWARD,0),"^",11),1:"")
|
|
S DGJTDEL=$G(^DG(40.8,+DGJTDIV,"DT"))
|
|
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
|
|
S DGJX=8,DGJY=2 D DOC S DGJT9=$S(X]"":X,1:"@"),X=""
|
|
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:"@")
|
|
S DGJTPR=DGJT9
|
|
Q
|
|
FL I DGJERROR=1 Q
|
|
S DGJFDE=0
|
|
F S DGJFDE=$O(DGJAR(DGJFDE)) Q:DGJFDE']"" D FL1
|
|
Q
|
|
FL1 S X=DFN,DIC="^VAS(393,",DIC(0)="L",DLAYGO=393 K DD,DO D FILE^DICN
|
|
S DGJTST=$O(^DG(393.2,"B","INCOMPLETE",0))
|
|
I Y>0 S DIE=DIC,DA=+Y
|
|
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
|
|
I Y>0 D ^DIE K DA,DR S DIE="^DGPM(",DA=DGJCA,DR="60.01///"_DGJDATE D ^DIE K DA,DR
|
|
Q
|
|
DIV 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
|
|
Q
|
|
DOC ;provider resp.
|
|
S X=$P(DGJTDEL,"^",DGJY)
|
|
S X=$S(X="A":$P(DGJT,"^",19),X="N":"",1:$P(DGJT,"^",8))
|
|
Q
|
|
DAT ;DATE RANGE
|
|
BEG 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
|
|
END 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
|
|
S DGJED=Y_.2359
|
|
I DGJED\1<DGJBG W !!?5,"The ending date cannot be before the beginning date" G END
|
|
Q
|