source: WorldVistAEHR/trunk/r/INCOMPLETE_RECORDS_TRACKING-DGJ/DGJBGJ.m@ 1800

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