- DGPTOTRL ;ALB/MLI - PTF TRANSMITTED RECORD LIST ; 28 JAN 88 11:00
- ;;5.3;Registration;**58,164,1015**;Aug 13, 1993;Build 21
- 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
- DGPTOTRL ;ALB/MLI - PTF TRANSMITTED RECORD LIST ; 28 JAN 88 11:00
- +1 ;;5.3;Registration;**58,164,1015**;Aug 13, 1993;Build 21
- +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
