source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPTOTRL.m@ 1569

Last change on this file since 1569 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1DGPTOTRL ;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
5DATE 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")
101 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
122 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
203 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
23PRT 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
25T 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
26HEAD 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 ;
31QUIT 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
32DF W $TR($$FMTE^XLFDT(Y,"5DF")," ","0") Q
33NOW ;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
Note: See TracBrowser for help on using the repository browser.