Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGJBGJ

DGJBGJ.m

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