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