| 1 | DGPTOTRL ;ALB/MLI - PTF TRANSMITTED RECORD LIST ; 28 JAN 88 11:00
|
|---|
| 2 | ;;5.3;Registration;**58,164**;Aug 13, 1993
|
|---|
| 3 | W !!!,*7,*7,"THIS REPORT REQUIRES 132 COLUMN OUTPUT"
|
|---|
| 4 | I '$D(DGRTY) S Y=1 D RTY^DGPTUTL
|
|---|
| 5 | DATE W !!,"**** Date Range Selection ****"
|
|---|
| 6 | W ! S %DT="AE",%DT("A")=" Beginning DATE : " D ^%DT G:Y<0 QUIT S DGBDT=Y-.1 S:'$D(%DT(0)) %DT(0)=Y
|
|---|
| 7 | S %DT="AE",%DT("A")=" Ending DATE : " D ^%DT K %DT G:Y<0 QUIT W ! S DGEDT=Y+.9
|
|---|
| 8 | ;
|
|---|
| 9 | S DGPGM="1^DGPTOTRL",DGVAR="DGRTY^DGRTY0^DGBDT^DGEDT" D ZIS^DGUTQ G:POP QUIT U IO S X=132 X ^%ZOSF("RM")
|
|---|
| 10 | 1 S U="^",(DGPG,DGH)=0 D NOW F I=DGBDT:0 S I=$O(^DGP(45.83,"AP",I)) Q:I'>0!(I>DGEDT) F J=0:0 S J=$O(^DGP(45.83,"AP",I,J)) Q:J'>0 F K=0:0 S K=$O(^DGP(45.83,"AP",I,J,K)) Q:K'>0 S DGIFN=K D 2
|
|---|
| 11 | G:'$D(^UTILITY($J)) QUIT D 3,T,QUIT Q
|
|---|
| 12 | 2 Q:'$D(^DGPT(DGIFN,0)) Q:'^(0)!($P(^(0),U,11)'=+DGRTY)
|
|---|
| 13 | S DGI=^(0),DFN=$P(DGI,U),DGAD=$P(DGI,U,2),DGF=$P(DGI,U,3),DGSF=$P(DGI,U,5) Q:('$D(^(70))!($P(^(70),U)']"")) S DGDD=$P(^(70),U) Q:'$D(^DPT(DFN,0)) S DGI2=^(0),DGPT=$P(DGI2,U),DGSSN=$P(DGI2,U,9)
|
|---|
| 14 | S F=DGSF D NUMACT^DGPTSUF(11) I DGANUM'>0 S:DGSF="" F=1 K DGANUM
|
|---|
| 15 | I DGANUM>0 D
|
|---|
| 16 | .F DGCTR=1:1:DGANUM S:DGSF=""!(DGSF=DGSUFNAM(DGCTR)) F=1
|
|---|
| 17 | .K DGANUM,DGCTR,DGSUFNAM
|
|---|
| 18 | Q:'$D(^DGP(45.84,DGIFN,0)) S DGTR=^(0),DGRO=$P(DGTR,U,4),DGRB=$P(DGTR,U,5),DGTO=I S ^UTILITY($J,"T",DGF_F,+DGSSN,DGSSN,DGAD,DGIFN)=DGPT_"^"_DGDD_"^"_DGRB_"^"_DGRO_"^"_DGTO_"^"_DGF_DGSF
|
|---|
| 19 | S DGC(DGF_F)=$S($D(DGC(DGF_F)):DGC(DGF_F)+1,1:1) Q
|
|---|
| 20 | 3 S DGBDT=DGBDT+.1,DGEDT=DGEDT-.9,(I,K)=0
|
|---|
| 21 | F I1=0:0 S I=$O(^UTILITY($J,"T",I)) Q:I']"" F J=0:0 S J=$O(^UTILITY($J,"T",I,J)) Q:J'>0 F K1=0:0 S K=$O(^UTILITY($J,"T",I,J,K)) Q:K']"" F L=0:0 S L=$O(^UTILITY($J,"T",I,J,K,L)) Q:L'>0 F M=0:0 S M=$O(^UTILITY($J,"T",I,J,K,L,M)) Q:M'>0 D PRT
|
|---|
| 22 | Q
|
|---|
| 23 | PRT S DGST=^UTILITY($J,"T",I,J,K,L,M),DGRB=$P(DGST,U,3) D:$Y=(IOSL-4)!(DGH'=I) HEAD S DGH=I
|
|---|
| 24 | W !,K,?14 S Y=L D DF W ?26,$P(DGST,U,6),?38,$E($P(DGST,U),1,25),?66,$J(M,6),?75 S Y=$P(DGST,U,2) D DF W ?87,$E($S($D(^VA(200,+DGRB,0)):$P(^(0),U),1:""),1,20),?110 S Y=$P(DGST,U,4) D DF W ?121 S Y=$P(DGST,U,5) D DF Q
|
|---|
| 25 | T K DGW S F=$E(DGH,1,3) S:DGH=(F_1) DGW="Facility "_F_" and/or associated facilities" W !!,?40,"Total Transmitted Records From ",$S($D(DGW):DGW,1:"Facility "_DGH),": ",?128,$J(DGC(DGH),4) Q
|
|---|
| 26 | HEAD D:DGH'=I&(DGH'=0) T S DGPG=DGPG+1
|
|---|
| 27 | W @IOF,!,?54,$P(DGRTY0,U)," TRANSMITTED RECORDS LIST",?121,"PAGE: ",$J(DGPG,3),!,?52 S Y=DGBDT D DT^DIQ W " - " S Y=DGEDT D DT^DIQ
|
|---|
| 28 | W !?54,"DATE RUN: ",DGNOW,!!?14,"ADMISSION",?26,"FACILITY/",?75,$S(DGRTY=1:"DISCHARGE",1:"CENSUS")
|
|---|
| 29 | W ?87,"RELEASED",?110,"RELEASED",?121,"TRANSMITTED",!,"SSN",?14,"DATE",?26,"SUFFIX",?38,"PATIENT NAME",?66,$S(DGRTY=1:"PTF",1:"CENSUS")," #",?75,"DATE",?87,"BY",?110,"ON",?121,"ON",! K Y S $P(Y,"-",133)="" W Y,! Q
|
|---|
| 30 | ;
|
|---|
| 31 | QUIT W ! D CLOSE^DGUTQ K %DT,^UTILITY($J),DFN,DGAD,DGBDT,DGC,DGDD,DGEDT,DGF,DGH,DGHX,DGI,DGI2,DGIFN,DGNOW,DGPG,DGPGM,DGPT,DGRB,DGRO,DGSF,DGSSN,DGST,DGTO,DGTR,DGVAR,DGW,F,I,I1,J,K,K1,L,M,POP,X,Y Q
|
|---|
| 32 | DF W $TR($$FMTE^XLFDT(Y,"5DF")," ","0") Q
|
|---|
| 33 | NOW ;Called from other routines...gets present date/time and formats for outputs
|
|---|
| 34 | S:$D(X) DGHX=X S:$D(Y) DGHY=Y S %DT="R",X="N" D ^%DT S DGNOW=$TR($$FMTE^XLFDT(Y,"5DF")," ","0")_"@"_$P(Y,".",2) S:$D(DGHX) X=DGHX S:$D(DGHY) Y=DGHY K DGHX,DGHY Q
|
|---|
