DGPTOTRL ;ALB/MLI - PTF TRANSMITTED RECORD LIST ; 28 JAN 88 11:00
;;5.3;Registration;**58,164**;Aug 13, 1993
W !!!,*7,*7,"THIS REPORT REQUIRES 132 COLUMN OUTPUT"
I '$D(DGRTY) S Y=1 D RTY^DGPTUTL
DATE W !!,"**** Date Range Selection ****"
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
S %DT="AE",%DT("A")=" Ending DATE : " D ^%DT K %DT G:Y<0 QUIT W ! S DGEDT=Y+.9
;
S DGPGM="1^DGPTOTRL",DGVAR="DGRTY^DGRTY0^DGBDT^DGEDT" D ZIS^DGUTQ G:POP QUIT U IO S X=132 X ^%ZOSF("RM")
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
G:'$D(^UTILITY($J)) QUIT D 3,T,QUIT Q
2 Q:'$D(^DGPT(DGIFN,0)) Q:'^(0)!($P(^(0),U,11)'=+DGRTY)
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)
S F=DGSF D NUMACT^DGPTSUF(11) I DGANUM'>0 S:DGSF="" F=1 K DGANUM
I DGANUM>0 D
.F DGCTR=1:1:DGANUM S:DGSF=""!(DGSF=DGSUFNAM(DGCTR)) F=1
.K DGANUM,DGCTR,DGSUFNAM
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
S DGC(DGF_F)=$S($D(DGC(DGF_F)):DGC(DGF_F)+1,1:1) Q
3 S DGBDT=DGBDT+.1,DGEDT=DGEDT-.9,(I,K)=0
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
Q
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
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
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
HEAD D:DGH'=I&(DGH'=0) T S DGPG=DGPG+1
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
W !?54,"DATE RUN: ",DGNOW,!!?14,"ADMISSION",?26,"FACILITY/",?75,$S(DGRTY=1:"DISCHARGE",1:"CENSUS")
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
;
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
DF W $TR($$FMTE^XLFDT(Y,"5DF")," ","0") Q
NOW ;Called from other routines...gets present date/time and formats for outputs
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTOTRL 3222 printed Oct 16, 2024@18:53:53 Page 2
DGPTOTRL ;ALB/MLI - PTF TRANSMITTED RECORD LIST ; 28 JAN 88 11:00
+1 ;;5.3;Registration;**58,164**;Aug 13, 1993
+2 WRITE !!!,*7,*7,"THIS REPORT REQUIRES 132 COLUMN OUTPUT"
+3 IF '$DATA(DGRTY)
SET Y=1
DO RTY^DGPTUTL
DATE WRITE !!,"**** Date Range Selection ****"
+1 WRITE !
SET %DT="AE"
SET %DT("A")=" Beginning DATE : "
DO ^%DT
if Y<0
GOTO QUIT
SET DGBDT=Y-.1
if '$DATA(%DT(0))
SET %DT(0)=Y
+2 SET %DT="AE"
SET %DT("A")=" Ending DATE : "
DO ^%DT
KILL %DT
if Y<0
GOTO QUIT
WRITE !
SET DGEDT=Y+.9
+3 ;
+4 SET DGPGM="1^DGPTOTRL"
SET DGVAR="DGRTY^DGRTY0^DGBDT^DGEDT"
DO ZIS^DGUTQ
if POP
GOTO QUIT
USE IO
SET X=132
XECUTE ^%ZOSF("RM")
1 SET U="^"
SET (DGPG,DGH)=0
DO NOW
FOR I=DGBDT:0
SET I=$ORDER(^DGP(45.83,"AP",I))
if I'>0!(I>DGEDT)
QUIT
FOR J=0:0
SET J=$ORDER(^DGP(45.83,"AP",I,J))
if J'>0
QUIT
FOR K=0:0
SET K=$ORDER(^DGP(45.83,"AP",I,J,K))
if K'>0
QUIT
SET DGIFN=K
DO 2
+1 if '$DATA(^UTILITY($JOB))
GOTO QUIT
DO 3
DO T
DO QUIT
QUIT
2 if '$DATA(^DGPT(DGIFN,0))
QUIT
if '^(0)!($PIECE(^(0),U,11)'=+DGRTY)
QUIT
+1 SET DGI=^(0)
SET DFN=$PIECE(DGI,U)
SET DGAD=$PIECE(DGI,U,2)
SET DGF=$PIECE(DGI,U,3)
SET DGSF=$PIECE(DGI,U,5)
if ('$DATA(^(70))!($PIECE(^(70),U)']""))
QUIT
SET DGDD=$PIECE(^(70),U)
if '$DATA(^DPT(DFN,0))
QUIT
SET DGI2=^(0)
SET DGPT=$PIECE(DGI2,U)
SET DGSSN=$PIECE(DGI2,U,9)
+2 SET F=DGSF
DO NUMACT^DGPTSUF(11)
IF DGANUM'>0
if DGSF=""
SET F=1
KILL DGANUM
+3 IF DGANUM>0
Begin DoDot:1
+4 FOR DGCTR=1:1:DGANUM
if DGSF=""!(DGSF=DGSUFNAM(DGCTR))
SET F=1
+5 KILL DGANUM,DGCTR,DGSUFNAM
End DoDot:1
+6 if '$DATA(^DGP(45.84,DGIFN,0))
QUIT
SET DGTR=^(0)
SET DGRO=$PIECE(DGTR,U,4)
SET DGRB=$PIECE(DGTR,U,5)
SET DGTO=I
SET ^UTILITY($JOB,"T",DGF_F,+DGSSN,DGSSN,DGAD,DGIFN)=DGPT_"^"_DGDD_"^"_DGRB_"^"_DGRO_"^"_DGTO_"^"_DGF_DGSF
+7 SET DGC(DGF_F)=$SELECT($DATA(DGC(DGF_F)):DGC(DGF_F)+1,1:1)
QUIT
3 SET DGBDT=DGBDT+.1
SET DGEDT=DGEDT-.9
SET (I,K)=0
+1 FOR I1=0:0
SET I=$ORDER(^UTILITY($JOB,"T",I))
if I']""
QUIT
FOR J=0:0
SET J=$ORDER(^UTILITY($JOB,"T",I,J))
if J'>0
QUIT
FOR K1=0:0
SET K=$ORDER(^UTILITY($JOB,"T",I,J,K))
if K']""
QUIT
FOR L=0:0
SET L=$ORDER(^UTILITY($JOB,"T",I,J,K,L))
if L'>0
QUIT
FOR M=0:0
SET M=$ORDER(^UTILITY($JOB,"T",I,J,K,L,M))
if M'>0
QUIT
DO PRT
+2 QUIT
PRT SET DGST=^UTILITY($JOB,"T",I,J,K,L,M)
SET DGRB=$PIECE(DGST,U,3)
if $Y=(IOSL-4)!(DGH'=I)
DO HEAD
SET DGH=I
+1 WRITE !,K,?14
SET Y=L
DO DF
WRITE ?26,$PIECE(DGST,U,6),?38,$EXTRACT($PIECE(DGST,U),1,25),?66,$JUSTIFY(M,6),?75
SET Y=$PIECE(DGST,U,2)
DO DF
WRITE ?87,$EXTRACT($SELECT($DATA(^VA(200,+DGRB,0)):$PIECE(^(0),U),1:""),1,20),?110
SET Y=$PIECE(DGST,U,4)
DO DF
WRITE ?121
SET Y=$PIECE(DGST,U,5)
DO DF
QUIT
T KILL DGW
SET F=$EXTRACT(DGH,1,3)
if DGH=(F_1)
SET DGW="Facility "_F_" and/or associated facilities"
WRITE !!,?40,"Total Transmitted Records From ",$SELECT($DATA(DGW):DGW,1:"Facility "_DGH),": ",?128,$JUSTIFY(DGC(DGH),4)
QUIT
HEAD if DGH'=I&(DGH'=0)
DO T
SET DGPG=DGPG+1
+1 WRITE @IOF,!,?54,$PIECE(DGRTY0,U)," TRANSMITTED RECORDS LIST",?121,"PAGE: ",$JUSTIFY(DGPG,3),!,?52
SET Y=DGBDT
DO DT^DIQ
WRITE " - "
SET Y=DGEDT
DO DT^DIQ
+2 WRITE !?54,"DATE RUN: ",DGNOW,!!?14,"ADMISSION",?26,"FACILITY/",?75,$SELECT(DGRTY=1:"DISCHARGE",1:"CENSUS")
+3 WRITE ?87,"RELEASED",?110,"RELEASED",?121,"TRANSMITTED",!,"SSN",?14,"DATE",?26,"SUFFIX",?38,"PATIENT NAME",?66,$SELECT(DGRTY=1:"PTF",1:"CENSUS")," #",?75,"DATE",?87,"BY",?110,"ON",?121,"ON",!
KILL Y
SET $PIECE(Y,"-",133)=""
WRITE Y,!
QUIT
+4 ;
QUIT WRITE !
DO CLOSE^DGUTQ
KILL %DT,^UTILITY($JOB),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
QUIT
DF WRITE $TRANSLATE($$FMTE^XLFDT(Y,"5DF")," ","0")
QUIT
NOW ;Called from other routines...gets present date/time and formats for outputs
+1 if $DATA(X)
SET DGHX=X
if $DATA(Y)
SET DGHY=Y
SET %DT="R"
SET X="N"
DO ^%DT
SET DGNOW=$TRANSLATE($$FMTE^XLFDT(Y,"5DF")," ","0")_"@"_$PIECE(Y,".",2)
if $DATA(DGHX)
SET X=DGHX
if $DATA(DGHY)
SET Y=DGHY
KILL DGHX,DGHY
QUIT
