DGPTOM2 ;ALB/AS - PTF MEANS TEST INDICATOR of 'U' Report (CONT) ; 2 FEB 90 14:30
;;5.3;Registration;;Aug 13, 1993
G:'$D(^DGPT("AMT","U")) NONE K ^UTILITY($J,"DGPTFU") D LO^DGUTL S $P(DGLN,"=",81)="",(DGTOT,DGPAG)=0,DGQUIT=""
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
G:'$D(^UTILITY($J,"DGPTFU")) NONE D HDR,PRT G Q:DGQUIT W !,"Total of ",DGTOT," PTF Records" D PG G Q
DT 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
D MT^DGPTUTL Q:$P(^DGPT(PTF,0),U,10)'="U" S DGMTDT=$P($$LST^DGMTU(DFN,$P($G(^DGPT(PTF,70)),".")),U,4)
;
S DGMTDT=$S(DGMTDT'>0:"*"_DGDATE,1:9999999-DGMTDT) I DGP S ^UTILITY($J,"DGPTFU",1,DGNAME,SSN,PTF)=$P(DGMTDT,".") Q
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
LN 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
Q
WLN W !,DGNAME,?35,SSN,?48,PTF,?56,$S(DGDATE["*":"** ",1:""),DGMTDT S DGTOT=DGTOT+1 Q
PG S N=$S('$D(IOSL):55,1:(IOSL-11)) F Y=$Y:1:N W !
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"
W !," appropriate means test indicator cannot be determined",!!?35,"-",DGPAG,"-",! Q
HDR 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 "
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")
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
PRT 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
Q
CONT Q:DGPAG=0 F N=$Y:1:(IOSL-2) W !
R ?22,"Enter <RET> to continue or ^ to QUIT ",N:DTIME S:N["^"!('$T) DGQUIT=1 Q
NONE W @IOF,!,"No PTF records with Means Test Indicators of 'U' within "_$S(DGD:"discharge",1:"admission")_" date range selected"
Q 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTOM2 2882 printed Dec 13, 2024@02:53:17 Page 2
DGPTOM2 ;ALB/AS - PTF MEANS TEST INDICATOR of 'U' Report (CONT) ; 2 FEB 90 14:30
+1 ;;5.3;Registration;;Aug 13, 1993
+2 if '$DATA(^DGPT("AMT","U"))
GOTO NONE
KILL ^UTILITY($JOB,"DGPTFU")
DO LO^DGUTL
SET $PIECE(DGLN,"=",81)=""
SET (DGTOT,DGPAG)=0
SET DGQUIT=""
+3 FOR PTF=0:0
SET PTF=$ORDER(^DGPT("AMT","U",PTF))
if PTF'>0
QUIT
IF $DATA(^DGPT(PTF,0))
IF $PIECE(^(0),U,11)=1
DO DT
+4 if '$DATA(^UTILITY($JOB,"DGPTFU"))
GOTO NONE
DO HDR
DO PRT
if DGQUIT
GOTO Q
WRITE !,"Total of ",DGTOT," PTF Records"
DO PG
GOTO Q
DT SET DGDATE=$SELECT('DGD:$PIECE(^DGPT(PTF,0),"^",2),$DATA(^DGPT(PTF,70)):+$PIECE(^(70),"^"),1:"")
if DGDATE<DGSD!(DGDATE>DGED)
QUIT
SET I=^DGPT(PTF,0)
SET DFN=+I
SET DGADM=$PIECE(I,"^",2)
SET I=^DPT(DFN,0)
SET DGNAME=$PIECE(I,"^")
SET SSN=$PIECE(I,"^",9)
NEW DGPMAN,DGPMCA
DO PM^DGPTUTL
+1 DO MT^DGPTUTL
if $PIECE(^DGPT(PTF,0),U,10)'="U"
QUIT
SET DGMTDT=$PIECE($$LST^DGMTU(DFN,$PIECE($GET(^DGPT(PTF,70)),".")),U,4)
+2 ;
+3 SET DGMTDT=$SELECT(DGMTDT'>0:"*"_DGDATE,1:9999999-DGMTDT)
IF DGP
SET ^UTILITY($JOB,"DGPTFU",1,DGNAME,SSN,PTF)=$PIECE(DGMTDT,".")
QUIT
+4 SET N=" "_$EXTRACT(SSN,8,9)_$EXTRACT(SSN,6,7)_$EXTRACT(SSN,4,5)_$EXTRACT(SSN,1,3)
SET ^UTILITY($JOB,"DGPTFU",N,DGNAME,SSN,PTF)=$PIECE(DGMTDT,".")
QUIT
LN FOR PTF=0:0
SET PTF=$ORDER(^UTILITY($JOB,"DGPTFU",DGSB,DGNAME,SSN,PTF))
if PTF'>0!(DGQUIT)
QUIT
SET DGDATE=^(PTF)
SET Y=$SELECT(DGDATE["*":$PIECE(DGDATE,"*",2),1:DGDATE)
XECUTE ^DD("DD")
SET DGMTDT=Y
if $Y>$SELECT('$DATA(IOSL)
DO HDR
if DGQUIT
QUIT
DO WLN
+1 QUIT
WLN WRITE !,DGNAME,?35,SSN,?48,PTF,?56,$SELECT(DGDATE["*":"** ",1:""),DGMTDT
SET DGTOT=DGTOT+1
QUIT
PG SET N=$SELECT('$DATA(IOSL):55,1:(IOSL-11))
FOR Y=$Y:1:N
WRITE !
+1 WRITE !,"* 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"
+2 WRITE !," appropriate means test indicator cannot be determined",!!?35,"-",DGPAG,"-",!
QUIT
HDR if DGPAG>0
DO PG
if (IOST?1"C-".E)
DO CONT
if DGQUIT
QUIT
WRITE @IOF,!,"PTF Means Test Indicator of 'U' Report",?58,"Printed: "
SET Y=DT
XECUTE ^DD("DD")
WRITE Y,!,"For ",$SELECT(DGD:"discharge",1:"admission")," date range from "
+1 SET Y=DGSD+.1
XECUTE ^DD("DD")
WRITE $PIECE(Y,"@")," to "
SET Y=DGED
XECUTE ^DD("DD")
WRITE $PIECE(Y,"@"),!,"Sorted by ",$SELECT(DGP:"patient last name",1:"terminal digit order")
+2 WRITE !!,"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
SET DGPAG=DGPAG+1
QUIT
PRT SET DGSB=""
FOR I=0:0
SET DGSB=$ORDER(^UTILITY($JOB,"DGPTFU",DGSB))
if DGSB']""!(DGQUIT)
QUIT
SET DGNAME=""
FOR N=0:0
SET DGNAME=$ORDER(^UTILITY($JOB,"DGPTFU",DGSB,DGNAME))
if DGNAME']""
QUIT
SET SSN=""
FOR Y=0:0
SET SSN=$ORDER(^UTILITY($JOB,"DGPTFU",DGSB,DGNAME,SSN))
if SSN']""
QUIT
DO LN
+1 QUIT
CONT if DGPAG=0
QUIT
FOR N=$Y:1:(IOSL-2)
WRITE !
+1 READ ?22,"Enter <RET> to continue or ^ to QUIT ",N:DTIME
if N["^"!('$TEST)
SET DGQUIT=1
QUIT
NONE WRITE @IOF,!,"No PTF records with Means Test Indicators of 'U' within "_$SELECT(DGD:"discharge",1:"admission")_" date range selected"
Q KILL ^UTILITY($JOB,"DGPTFU"),DGLN,Y,PTF,DGADM,DGD,DGED,DGP,DGSD,DGTOT,DGMTDT,DGDT,DGSB,DGPAG,DGDATE,DGNAME,DGQUIT,DFN,SSN,N,I
QUIT
