DGJBGJ ;ALB/MAF - IRT BACKGROUND JOB/SHORT FORM LIST - MAY 3 1993
;;5.3;Registration;**126,1015**;Aug 13, 1993;Build 21
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 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
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,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=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
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 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
DGJBGJ ;ALB/MAF - IRT BACKGROUND JOB/SHORT FORM LIST - MAY 3 1993
+1 ;;5.3;Registration;**126,1015**;Aug 13, 1993;Build 21
EN NEW DGJBG,DGJED
+1 DO DAT
+2 IF Y=-1
GOTO QUIT
+3 ;D START Q ;Line for testing
+4 SET ZTIO=""
SET ZTRTN="START^DGJBGJ"
SET ZTDESC="IRT Background Job to Initialize admissions with standard deficiencies"
+5 FOR X="DGJBG","DGJED"
SET ZTSAVE(X)=""
+6 KILL ZTSK
DO ^%ZTLOAD
IF $DATA(ZTSK)
WRITE " (TASK: #",ZTSK,")"
+7 QUIT
AUTO ;Nightly Job Entry Point
+1 SET X1=DT
SET X2=-2
DO C^%DTC
+2 SET (DGJFLAG,DGJFLG)=0
+3 SET DGJBG=X
SET DGJED=X+.2359
DO SHORT
+4 SET X1=DT
SET X2=-1
DO C^%DTC
+5 SET DGJBG=X
SET DGJED=X+.2359
DO START
+6 QUIT
SHORT SET DGJX=0
SET DGJDEF=0
SET DGJDA=0
+1 FOR
SET DGJBG=$ORDER(^DGPM("B",DGJBG))
IF DGJBG']""!(DGJBG>DGJED)
QUIT
FOR
SET DGJDA=$ORDER(^DGPM("B",DGJBG,DGJDA))
IF 'DGJDA
QUIT
IF $DATA(^DGPM(DGJDA,0))
IF $PIECE(^DGPM(DGJDA,0),"^",2)=1
IF $PIECE(^DGPM(DGJDA,0),"^",17)
DO SET
DO CK
+2 QUIT
CK SET DGJFLAG=0
SET X2=$PIECE($GET(^DGPM(+DGJCA,0)),"^",1)
SET X1=$PIECE($GET(^DGPM(+DGJDIS,0)),"^",1)
IF X1=X2
QUIT
DO ^%DTC
IF X<2
DO SETUP
SET DGJFLAG=1
+1 QUIT
SETSTR(S,V,X,L) ; -- insert text(S) into variable(V)
+1 ; S := string
+2 ; V := destination
+3 ; X := @ col X
+4 ; L := # of chars
+5 ;
+6 QUIT $EXTRACT(V_$JUSTIFY("",X-1),1,X-1)_$EXTRACT(S_$JUSTIFY("",L),1,L)_$EXTRACT(V,X+L,999)
SETUP SET DFN=$PIECE(DGJTND,"^",3)
DO PID^VADPT6
SET VAIP("D")=$PIECE(^DGPM(DGJDIS,0),"^",1)-.000001
DO IN5^VADPT
SET X=+VAIP(5)
SET DGJDIV=$SELECT($DATA(^DIC(42,+X,0)):$PIECE(^DIC(42,X,0),"^",11),1:"")
+1 IF $DATA(^DGPM(+DGJDIS,0))
SET DGJTTYP=$PIECE(^(0),"^",4)
SET DGJTTYP=$SELECT($DATA(^DG(405.1,+DGJTTYP,0)):$EXTRACT($PIECE(^(0),"^",1),1,20),1:"")
+2 SET X=""
+3 SET X=$$SETSTR($EXTRACT($PIECE(^DPT($PIECE(DGJTND,"^",3),0),"^",1),1,15),X,1,15)
+4 SET X=$$SETSTR(VA("BID"),X,19,5)
+5 SET X=$$SETSTR($$FTIME^VALM1($PIECE($GET(^DGPM(DGJCA,0)),"^",1)),X,28,18)
+6 SET X=$$SETSTR(DGJTTYP,X,50,15)
+7 SET X=$$SETSTR($SELECT($GET(^DG(40.8,+DGJDIV,0))]"":$PIECE(^DG(40.8,+DGJDIV,0),"^",1),1:""),X,69,11)
+8 SET ^TMP("VAS",$JOB,$SELECT($GET(^DG(40.8,+DGJDIV,0))]"":$PIECE(^DG(40.8,+DGJDIV,0),"^",1),1:""),$PIECE($GET(^DGPM(DGJCA,0)),"^"),DGJCA,0)=X
+9 QUIT
SET SET (DGJTND,DGJCA,DGJDIS)=""
SET DGJTND=$GET(^DGPM(DGJDA,0))
SET DGJCA=$PIECE(DGJTND,"^",14)
SET DGJDIS=$PIECE(DGJTND,"^",17)
IF DGJDIS']""
SET DGJFLG=1
QUIT
START SET (DGJFLAG,DGJFLG)=0
DO NOW^%DTC
SET DGJDATE=%
+1 SET DGJX=0
SET DGJDEF=0
SET DGJDA=0
+2 FOR
SET DGJDEF=$ORDER(^VAS(393.3,DGJDEF))
IF DGJDEF']""
QUIT
SET DGJNODE=$GET(^VAS(393.3,DGJDEF,0))
IF $PIECE(DGJNODE,"^",8)=1
IF DGJDEF'=$ORDER(^VAS(393.3,"B","DISCHARGE SUMMARY",0))
SET DGJAR(DGJDEF)=""
+3 FOR
SET DGJBG=$ORDER(^DGPM("B",DGJBG))
IF DGJBG']""!(DGJBG>DGJED)
QUIT
FOR
SET DGJDA=$ORDER(^DGPM("B",DGJBG,DGJDA))
IF 'DGJDA
QUIT
IF $DATA(^DGPM(DGJDA,0))
IF $PIECE(^DGPM(DGJDA,0),"^",2)=1
DO SET
IF DGJDIS]""
DO CK
IF DGJFLAG
DO DIV
IF DGJFLG
IF '$DATA(^DGPM(+DGJCA,"IRT"))
DO UP
DO FL
+4 SET DIE="^DG(43,"
SET DA=1
SET DR="401///"_DGJDATE
DO ^DIE
KILL DA,DR
+5 DO MSG^DGJBGJ1
QUIT KILL %,%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
+1 KILL DGJB,DGJDIS,DGJDIV,DGJI,DGJMSG,DGJSTD,DGJTTYP,VA,DGJBG,DGJDA,DGJDEF,DGJED,DGJFLAG,DGJFLG,DGJTCNT,DGJX,X,DGJTWARD,VAERR,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,^TMP("VAS",$JOB)
QUIT
UP SET DGJFLG=0
SET DFN=$PIECE(DGJTND,"^",3)
IF DFN']""
QUIT
SET VAIP("D")=$SELECT(DGJDIS]""&($DATA(^DGPM(+DGJDIS,0))):$PIECE(^DGPM(DGJDIS,0),"^",1)-.000001,1:"L")
+1 DO IN5^VADPT
+2 SET DGJTWARD=+VAIP(5)
+3 SET DGJTWD=$SELECT($DATA(^DIC(42,DGJTWARD,0)):^DIC(42,DGJTWARD,44),1:"")
+4 SET DGJTSV=$SELECT(DGJTWARD]"":$PIECE(^DIC(42,+DGJTWARD,0),"^",3),1:"")
+5 SET DGJTSP=+VAIP(8)
+6 IF DGJTSV=""
SET DGJTSV=0
SET DGJTSV=$SELECT(DGJTSV=0:12,$DATA(^DG(393.1,"AC",DGJTSV)):$ORDER(^(DGJTSV,0)),1:"")
+7 SET DGJEVT=+DGJTND
+8 SET DGJTDIV=$SELECT($DATA(^DIC(42,DGJTWARD,0)):$PIECE(^DIC(42,DGJTWARD,0),"^",11),1:"")
+9 SET DGJTDEL=$GET(^DG(40.8,+DGJTDIV,"DT"))
+10 ;last TS mvt
SET DGJT=$ORDER(^DGPM("ATS",DFN,DGJCA,0))
SET DGJT=$ORDER(^(+DGJT,0))
SET DGJT=$ORDER(^(+DGJT,0))
SET DGJT=$SELECT($DATA(^DGPM(+DGJT,0)):^(0),1:"")
+11 SET DGJX=8
SET DGJY=2
DO DOC
SET DGJT9=$SELECT(X]"":X,1:"@")
SET X=""
+12 SET DGJT10=""
IF $PIECE(DGJTDEL,"^",3)!('$PIECE(DGJTDEL,"^",3)&($PIECE(DGJTDEL,"^",10)="A"))
SET DGJX=19
SET DGJY=4
DO DOC
SET DGJT10=$SELECT(X]"":X,1:"@")
+13 SET DGJTPR=DGJT9
+14 QUIT
FL SET DGJFDE=0
+1 FOR
SET DGJFDE=$ORDER(DGJAR(DGJFDE))
IF DGJFDE']""
QUIT
DO FL1
+2 QUIT
FL1 SET X=DFN
SET DIC="^VAS(393,"
SET DIC(0)="L"
SET DLAYGO=393
KILL DD,DO
DO FILE^DICN
+1 SET DGJTST=$ORDER(^DG(393.2,"B","INCOMPLETE",0))
+2 IF Y>0
SET DIE=DIC
SET DA=+Y
+3 IF Y>0
SET DR=".02////"_DGJFDE_";.03////"_DGJEVT_";.04////"_DGJCA_";.05////"_DGJTWD_";.06////"_DGJTDIV_";.07////"_DGJTSP_";.08////"_DGJTSV_";.09////"_DGJT9_";.1////"_DGJT10_";.11////"_DGJTST_";.12////"_DGJT9
+4 IF Y>0
DO ^DIE
KILL DA,DR
SET DIE="^DGPM("
SET DA=DGJCA
SET DR="60.01///"_DGJDATE
DO ^DIE
KILL DA,DR
+5 QUIT
DIV SET (DGJFLG,DGJFLAG)=0
IF $DATA(^DG(40.8,DGJDIV,"DT"))
SET DGJSTD=$PIECE(^DG(40.8,DGJDIV,"DT"),"^",11)
IF DGJSTD=1
SET DGJFLG=1
+1 QUIT
DOC ;provider resp.
+1 SET X=$PIECE(DGJTDEL,"^",DGJY)
+2 SET X=$SELECT(X="A":$PIECE(DGJT,"^",19),X="N":"",1:$PIECE(DGJT,"^",8))
+3 QUIT
DAT ;DATE RANGE
BEG WRITE !
SET %DT="AEX"
SET %DT("A")="Select Beginning Date: "
DO ^%DT
SET DGJBG=Y
IF X="^"!(X="")
SET Y=-1
IF Y=-1
QUIT
DO NOW^%DTC
IF DGJBG>$PIECE(%,".",1)
WRITE !!,"Dates in the future are not allowed!"
GOTO BEG
END WRITE !
SET %DT("A")="Select Ending Date : "
DO ^%DT
IF X="^"!(X="")
SET Y=-1
IF Y=-1
QUIT
IF Y<1
DO HELP^%DTC
GOTO END
+1 SET DGJED=Y_.2359
+2 IF DGJED\1<DGJBG
WRITE !!?5,"The ending date cannot be before the beginning date"
GOTO END
+3 QUIT
