| 1 | DVBAUTIL ;ALB ISC/THM-AMIE UTILITIES ; 1/16/91 2:58 PM
|
|---|
| 2 | ;;2.7;AMIE;**17,32**;Apr 10, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | SORT W !!,"Sort by Regional Office number" S %=1 D YN^DICN I $D(DTOUT)!(%<0) K DTOUT S Y=-1 Q
|
|---|
| 5 | I $D(%Y) I %Y["?" W !!,*7,"Enter Y to sort by the Regional Office number you",!,"select or enter N to get ALL Regional Offices reported." G SORT
|
|---|
| 6 | I %'=1 S RO="N",RONUM=0 Q
|
|---|
| 7 | I %=1 S RO="Y" G RONUM
|
|---|
| 8 | W !,*7,"Invalid response.",!! G SORT
|
|---|
| 9 | ;
|
|---|
| 10 | RONUM W !,"Regional Office number: " R RONUM:DTIME G:RONUM["^" SORT I '$T!(RONUM="") W *7 S Y=-1 Q
|
|---|
| 11 | I RONUM'?1.3N W *7," Must be 1-3 numbers.",!! G RONUM
|
|---|
| 12 | Q
|
|---|
| 13 | ;
|
|---|
| 14 | KILL ;kill all variables and exit selected program
|
|---|
| 15 | D ^%ZISC
|
|---|
| 16 | KILL1 K %DT,%ZIS,ANS,BDATE,CNUM,EDATE,L,MA,DA,NODTA,PNAM,Q,QQ,RDATE,SSN,XY,VER,J,LN,POP,FINALDTE,ADMDT,BEDSEC,CFLOC,DIAG,DCHGDT,HEAD,HEAD1,MB,RCVAA,RCVPEN,A,TYPE,C,ADMNUM,DIPGM,DIS,HNAME,DVBAQUIT,DSRP
|
|---|
| 17 | K WARD,NOASK,^TMP($J),DTOUT,ZTSK,IO("C"),I,RO,RONUM,LADM,K,RADM,%X,%Y,%XX,%YY,X,Y,ICDAT2,ICDAT,LOS,TDIS,DIC,POP,DVBATYPS,TO,NUMSEL,REP,DVBAFIND,DVBATP,DVBAPRNT,SITE,LINE,OPER,PG,HD,HD1,HEAD2,DVBADD
|
|---|
| 18 | K ZTIO,ZTDESC,ZTRTN,DATA,SC,LDCH,FDT(0),NAME,DIE,DR,ZX,ZI,XDA,XADMDT,DLAYGO,HD,D,DIC,Y,Z,ZTYPE,D0,D1,DI,DQ,CNM,CFLC,XDTA,MC,MD,PROCDT,ADMDATE,EDAYS,CNT,XLOC,TEMP,TEMPDA,%ZIS,%IS,DIVHD,XDIV,DVBADIV,ADIV,BDT,EDT
|
|---|
| 19 | K ZTYPE,DO,DTAR,X,Y,HEAD,HEAD1,ADTYPE,NDCH,DOCTYPE,ELIG,INCMP,LG,OUT,LADMDT,NONE,BDATE1,XDA2,ADM,DFN,DISCH,XCN,LCN,HOSP,NODE,T,TRN,ZTSAVE,ZDT,ZDT1,ZDA,IO("Q"),IOP,BDIV,EDIV,BDT1,EDT1,NEWREQ,BED,STAT,DVBADIC,ADMNUM
|
|---|
| 20 | K X2,DHD,DIWF,DIWL,DIWR,DVBASC,DVBAELIG,FNLDT,CFLC,HIST,DVBAELST,OLDY,PDATE,ZTDTH,DTA,VAINDT,VAIN,WWHO,SDATE,%,DVBAQUIT,NODE,NOFINAL,^TMP("ADMIT",$J),LOC,AA,DVBASTAT,OLDY,ADMDT,ANS1,CURADMDT,DVBADT,DVBAH,DVBAQ
|
|---|
| 21 | K DVBAI,DVBAT,HEADDT,HOSPDAYS,LBEDSEC,LDCHGDT,LDIAG,LLADM,LTDIS,MSG,MSG1,VX,VY,X1,XLINE,ZJ,ZY,ZZ,LOC,QUIT,QUIT1,^UTILITY($J),^TMP("DVBA",$J),^TMP("DVBA","PEN"),^TMP("DVBA","A&A"),DVBACEPT,DCHPTR,DVBA
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | LOS ;compute length of stay for discharge report
|
|---|
| 25 | S %DT="T" S X=ADMDT D ^%DT S X2=Y
|
|---|
| 26 | S X=DCHGDT D ^%DT S X1=Y K Y
|
|---|
| 27 | D ^%DTC S LOS=X I LOS=0 S LOS=""
|
|---|
| 28 | Q
|
|---|
| 29 | DATE W !,?5,"The entry of future dates is NOT allowed.",!
|
|---|
| 30 | S %DT(0)=-DT
|
|---|
| 31 | S %DT("A")="BEGINNING date: ",%DT="AET" D ^%DT W:X="^"!(Y=-1) !! Q:X=""!(Y=-1) S BDATE=Y
|
|---|
| 32 | S %DT("A")=" ENDING date: ",%DT="AET" D ^%DT S EDATE=Y Q:X="^"
|
|---|
| 33 | I EDATE<BDATE W !!,*7,"Invalid date sequence. Beginning date must be before the ending date.",!! H 2 G DATE
|
|---|
| 34 | S BDATE=BDATE-.5,EDATE=EDATE+.5
|
|---|
| 35 | D SORT K %DT(0) Q
|
|---|
| 36 | ;
|
|---|
| 37 | DICW S DVBADIC(0,"W")="S ZX=$P(^DVB(396,+Y,0),U,4) W:$X>40 ! W "" Admission date: "",$$FMTE^XLFDT(ZX,""5DZ"") W "" "",$S($P(^(1),U,12)'="""":""Finalized"",1:""Open"")"
|
|---|
| 38 | ;
|
|---|
| 39 | DICW1 S DVBADIC(1,"W")="S ZX=$P(^DVB(396,+Y,0),U,4) W:$X>40 ! W "" Activity date: "",$$FMTE^XLFDT(ZX,""5DZ"") W "" "",$S($P(^(1),U,12)'="""":""Finalized"",1:""Open"")"
|
|---|
| 40 | ;
|
|---|
| 41 | DICW2 S DIC("W")="S ZTYPE=$S($D(^DVB(396,+Y,2)):$P(^(2),U,10),1:""A"") X $S(ZTYPE=""L"":DVBADIC(1,""W""),1:DVBADIC(0,""W""))"
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | FINAL ;
|
|---|
| 45 | S $P(^DVB(396.1,1,0),"^",X)=DT ;x is the corresponding date field
|
|---|
| 46 | G KILL1
|
|---|
| 47 | ;
|
|---|
| 48 | DUZ2 K DVBAQUIT
|
|---|
| 49 | I $G(DUZ(2))="" W *7,!!,"You have no division code. Please contact the site manager.",!! H 3 S DVBAQUIT=1 Q
|
|---|
| 50 | S DVBAD2=$S($D(^DIC(4,+DUZ(2),99)):$P(^(99),U,1),1:0)
|
|---|
| 51 | I DVBAD2=0 W *7,!!,"Your division code is invalid.",!! H 3 S DVBAQUIT=1
|
|---|
| 52 | ; Flag if the division has no station # in the INSITUTION file.
|
|---|
| 53 | I $G(DVBAD2)="" W *7,!!,"Your division has no station number defined in the INSTITUTION file.",!,"Please consult IRM to request a unique station number for your division.",!! H 3 S DVBAQUIT=1
|
|---|
| 54 | Q
|
|---|
| 55 | S ;
|
|---|
| 56 | ;this code is currently not available but will be in future version
|
|---|
| 57 | ;of AMIE.
|
|---|
| 58 | Q
|
|---|
| 59 | S1 ;
|
|---|
| 60 | ;this code is currently not available but will be in future version
|
|---|
| 61 | ;of AMIE.
|
|---|
| 62 | Q
|
|---|
| 63 | K ;
|
|---|
| 64 | ;this code is currently not available but will be in future version
|
|---|
| 65 | ;of AMIE.
|
|---|
| 66 | Q
|
|---|
| 67 | K1 ;
|
|---|
| 68 | ;this code is currently not available but will be in future version
|
|---|
| 69 | ;of AMIE.
|
|---|
| 70 | Q
|
|---|
| 71 | ;
|
|---|
| 72 | EXIT ;called from the DVBAREG1 routine, kills off variables at end.
|
|---|
| 73 | S VAR(1,0)="0,0,0,0:2,1^"
|
|---|
| 74 | D WR^DVBAUTL4("VAR")
|
|---|
| 75 | K VAR,ADM,ADMDT,ANS,CNUM,DA,DFN,DIC,DIE,DR,PNAM,SSN,ZA,OPER,X,Y,POP,LOC,%,ZI,ONFILE,REOPEN,DVBADIV,STAT,ZX,HD,I,NAME,HNAME,DTAR,DTOUT,%Y,DOCTYPE,%Y1,DQ,DVBADIC,OUT,ZTYPE,A,ADMNUM,ANS1,OLDY,DVBASTAT,DVBAENTR,DVBAEDT
|
|---|
| 76 | K DVBAD2,DVBAX,DVBCSSNO,AROWOUT,DVBADM,DVBANL,DVBAPT,DVBAQUIT,DVBBDT,DVBCHK,DVBDISP,DVBEDT,DVBSPCOD,DVBVAR,DVBCNT,DVBAY,DVBDOC,DVBAIFN,DVBANS
|
|---|
| 77 | K ^TMP("DVBA",$J),^UTILITY("DIQ1",$J)
|
|---|
| 78 | Q
|
|---|
| 79 | ;
|
|---|
