source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPTOM2.m@ 1800

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

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1DGPTOM2 ;ALB/AS - PTF MEANS TEST INDICATOR of 'U' Report (CONT) ; 2 FEB 90 14:30
2 ;;5.3;Registration;;Aug 13, 1993
3 G:'$D(^DGPT("AMT","U")) NONE K ^UTILITY($J,"DGPTFU") D LO^DGUTL S $P(DGLN,"=",81)="",(DGTOT,DGPAG)=0,DGQUIT=""
4 F PTF=0:0 S PTF=$O(^DGPT("AMT","U",PTF)) Q:PTF'>0 I $D(^DGPT(PTF,0)),$P(^(0),U,11)=1 D DT
5 G:'$D(^UTILITY($J,"DGPTFU")) NONE D HDR,PRT G Q:DGQUIT W !,"Total of ",DGTOT," PTF Records" D PG G Q
6DT S DGDATE=$S('DGD:$P(^DGPT(PTF,0),"^",2),$D(^DGPT(PTF,70)):+$P(^(70),"^"),1:"") Q:DGDATE<DGSD!(DGDATE>DGED) S I=^DGPT(PTF,0),DFN=+I,DGADM=$P(I,"^",2),I=^DPT(DFN,0),DGNAME=$P(I,"^"),SSN=$P(I,"^",9) N DGPMAN,DGPMCA D PM^DGPTUTL
7 D MT^DGPTUTL Q:$P(^DGPT(PTF,0),U,10)'="U" S DGMTDT=$P($$LST^DGMTU(DFN,$P($G(^DGPT(PTF,70)),".")),U,4)
8 ;
9 S DGMTDT=$S(DGMTDT'>0:"*"_DGDATE,1:9999999-DGMTDT) I DGP S ^UTILITY($J,"DGPTFU",1,DGNAME,SSN,PTF)=$P(DGMTDT,".") Q
10 S N=" "_$E(SSN,8,9)_$E(SSN,6,7)_$E(SSN,4,5)_$E(SSN,1,3),^UTILITY($J,"DGPTFU",N,DGNAME,SSN,PTF)=$P(DGMTDT,".") Q
11LN F PTF=0:0 S PTF=$O(^UTILITY($J,"DGPTFU",DGSB,DGNAME,SSN,PTF)) Q:PTF'>0!(DGQUIT) S DGDATE=^(PTF),Y=$S(DGDATE["*":$P(DGDATE,"*",2),1:DGDATE) X ^DD("DD") S DGMTDT=Y D:$Y>$S('$D(IOSL):55,1:(IOSL-11)) HDR Q:DGQUIT D WLN
12 Q
13WLN W !,DGNAME,?35,SSN,?48,PTF,?56,$S(DGDATE["*":"** ",1:""),DGMTDT S DGTOT=DGTOT+1 Q
14PG S N=$S('$D(IOSL):55,1:(IOSL-11)) F Y=$Y:1:N W !
15 W !,"* The date in the APPLICABLE DATE OF TEST column is the date of means test ",!," which is used to determine this Means Test indicator",!,"** Denotes no date of means test on or before this date; therefore, an"
16 W !," appropriate means test indicator cannot be determined",!!?35,"-",DGPAG,"-",! Q
17HDR D:DGPAG>0 PG D:(IOST?1"C-".E) CONT Q:DGQUIT W @IOF,!,"PTF Means Test Indicator of 'U' Report",?58,"Printed: " S Y=DT X ^DD("DD") W Y,!,"For ",$S(DGD:"discharge",1:"admission")," date range from "
18 S Y=DGSD+.1 X ^DD("DD") W $P(Y,"@")," to " S Y=DGED X ^DD("DD") W $P(Y,"@"),!,"Sorted by ",$S(DGP:"patient last name",1:"terminal digit order")
19 W !!,"The following PTF Records have a Means Test Indicator of 'U' (means test is",!,"not done or not completed):",!!?48,"PTF",?56,"* APPLICABLE",!,"PATIENT NAME",?35,"SSN",?48,"NUMBER",?56,"DATE OF TEST",!,DGLN S DGPAG=DGPAG+1 Q
20PRT S DGSB="" F I=0:0 S DGSB=$O(^UTILITY($J,"DGPTFU",DGSB)) Q:DGSB']""!(DGQUIT) S DGNAME="" F N=0:0 S DGNAME=$O(^UTILITY($J,"DGPTFU",DGSB,DGNAME)) Q:DGNAME']"" S SSN="" F Y=0:0 S SSN=$O(^UTILITY($J,"DGPTFU",DGSB,DGNAME,SSN)) Q:SSN']"" D LN
21 Q
22CONT Q:DGPAG=0 F N=$Y:1:(IOSL-2) W !
23 R ?22,"Enter <RET> to continue or ^ to QUIT ",N:DTIME S:N["^"!('$T) DGQUIT=1 Q
24NONE W @IOF,!,"No PTF records with Means Test Indicators of 'U' within "_$S(DGD:"discharge",1:"admission")_" date range selected"
25Q K ^UTILITY($J,"DGPTFU"),DGLN,Y,PTF,DGADM,DGD,DGED,DGP,DGSD,DGTOT,DGMTDT,DGDT,DGSB,DGPAG,DGDATE,DGNAME,DGQUIT,DFN,SSN,N,I Q
Note: See TracBrowser for help on using the repository browser.