DGMTOREQ ;ALB/TET,CAW,CKN - List Means Test Status ; 5/6/92 ; 07/22/02 11:00am
;;5.3;Registration;**33,100,166,182,456**;Aug 13, 1993
EN ;Entry point to list required/pending means tests
ST ;select means test status
I DGMTYPT=1 S DIC("S")="I ""^R^P^""[$P(^(0),U,2)&($P(^(0),U,19)=DGMTYPT)"
I DGMTYPT=2 S DIC("S")="I ""^I^P^""[$P(^(0),U,2)&($P(^(0),U,19)=DGMTYPT),$$ACT^DGMTDD(Y,DT)",DIC("B")=9 ;Screen Status for Active
ST1 S DIC(0)="AEQMZ",DIC="^DG(408.32,"
S DIC("A")="Select "_$S(DGMTYPT=1:"MEANS",1:"COPAY")_" TEST STATUS NAME: "
D ^DIC K DIC G:$D(DTOUT)!($D(DUOUT)) EXIT G:Y'>0 ST
S DGCAT(+Y)=$P(Y,U,2)
;
DTB ;select beginning date
S DIR(0)="DO^::EX",DIR("A")="Enter Beginning Date",DIR("?")="^D HELP^%DTC" D ^DIR K DIR G:$D(DIRUT) EXIT S DGBEG=Y
I DGBEG>DT W !," Future dates are not allowed.",*7 K DGBEG G DTB
;select ending date
S DIR(0)="D^"_DGBEG_":NOW:EX",DIR("A")="Enter Ending Date",DIR("?")="^D HELP^%DTC" D ^DIR K DIR G:$D(DIRUT) EXIT
S DGEND=Y
;S DGBEG=DGBEG-.1,DGEND=Y_.9
Q ;select device and print
S DGVAR="DGCAT#^DGBEG^DGEND^DGMTYPT",DGPGM="DQ^DGMTOREQ"
D ZIS^DGUTQ G EXIT:POP U IO
DQ ;gather data and print
S DGC=$O(DGCAT(0)),DGCRT=$S($E(IOST,1,2)="C-":1,1:0)
S DGBEGE=$$DATE(DGBEG),DGENDE=$$DATE(DGEND),$P(DGDASH,"=",IOM-1)="",DGPG=0
S DGC(1)=$S(DGMTYPT=1:"MEANS",1:"COPAY")_" TEST STATUS Report",DGC(2)="STATUS: "_DGCAT(DGC)
S DGC(3)="From "_DGBEGE_" Through "_DGENDE
;flag for new column if Means test type is 1 and report selection is for pending means test data
S CFLG=0 I (DGMTYPT=1)&(DGC=2) S CFLG=1
SORT ;sort data into tmp global
I '$D(^DGMT(408.31,"AS",DGMTYPT,DGC)) S DGM="No patients found with "_$S(DGMTYPT=1:"means",1:"copay")_" test status of "_DGCAT(DGC)_"." D HDR W !!?10,DGM G EXIT
S DGD=-(DGEND+.9) F S DGD=$O(^DGMT(408.31,"AS",DGMTYPT,DGC,DGD)) Q:'DGD!(DGD>-DGBEG) D
.S DFN=0 F S DFN=$O(^DGMT(408.31,"AS",DGMTYPT,DGC,DGD,DFN)) Q:'DFN S DGSSN=$$PID(DFN),DGDPT0=$G(^DPT(DFN,0)) I DGDPT0]"" S DGNM=$S($P(DGDPT0,U)]"":$P(DGDPT0,U),1:DFN) D
..S DGDA=0 F S DGDA=$O(^DGMT(408.31,"AS",DGMTYPT,DGC,DGD,DFN,DGDA)) Q:'DGDA D
...Q:'$G(^DGMT(408.31,DGDA,"PRIM"))
...S DGMT0=$G(^DGMT(408.31,DGDA,0)) Q:'DGMT0
...S ^TMP($J,"DGMTO",DGNM,DFN,DGDA)=DGSSN_U_$P(DGMT0,U)_U_$$SR^DGMTAUD1(DGMT0)
...I CFLG D
....S PENDA=$$PA^DGMTUTL(DGDA)
....S ^TMP($J,"DGMTO",DGNM,DFN,DGDA)=$G(^TMP($J,"DGMTO",DGNM,DFN,DGDA))_U_PENDA
I $O(^TMP($J,"DGMTO",0))']"" S DGM="No patients found for requested date range." D HDR W !!?10,DGM G EXIT
PRINT ;print data from tmp global
D HDR
S DGNM=0 F S DGNM=$O(^TMP($J,"DGMTO",DGNM)) Q:DGNM="" D G:$D(DIRUT) EXIT
.S DFN=0 F S DFN=$O(^TMP($J,"DGMTO",DGNM,DFN)) Q:'DFN D Q:$D(DIRUT)
..S DGDA=0 F S DGDA=$O(^TMP($J,"DGMTO",DGNM,DFN,DGDA)) Q:'DGDA D:$Y+10>IOSL PAGE Q:$D(DIRUT) D
...S DG0=^TMP($J,"DGMTO",DGNM,DFN,DGDA)
...W !,DGNM,?24,$$PID($P(DG0,U)),?38,$P(DG0,U,3),?54,$$DATE($P(DG0,U,2))
...I CFLG W ?71,$P(DG0,U,4)
EXIT ;clean up and quit
I +$G(DGCRT),$Y'>(IOSL-10) D CR
K DFN,DG0,DGBEG,DGBEGE,DGC,DGCAT,DGCRT,DGD,DGDA,DGDPT0,DGDASH,DGEND,DGENDE,DGJ,DGM,DGMT0,DGMTYPT,DGNM,DGPG,DGSSN,DIC,DIR,DTOUT,DUOUT,DIRUT,VAERR,X,Y,PENDA,CFLG
D CLOSE^DGMTUTL,^%ZISC
K ^TMP($J)
Q
HDR ;header
I DGPG=0,DGCRT W @IOF
F I=1:1:3 W !?(IOM-$L(DGC(I))/2),DGC(I)
S DGPG=DGPG+1 W !?66,"Page ",DGPG,!,DGDASH,!
W !?38,$S(DGMTYPT=1:"Means",1:"Copay")_" Test",?56,"Date of"
I CFLG W ?67,"Pend. Adj."
W !,"Patient Name",?24,"Patient ID",?40,"Source",?58,"Test"
I CFLG W ?69,"Status"
W !,"------------",?24,"----------",?38,"----------",?56,"-------"
I CFLG W ?67,"----------"
Q
DATE(X) ;function to return date in external format
;INPUT - FM internal date format
;OUTPUT - external date format
Q $$FMTE^XLFDT($E(X,1,12),1)
;
PID(X) ;function to return pid
;INPUT - DFN
;OUTPUT - PID or UNKNOWN
D PID^VADPT6
Q $S(VA("PID")]"":VA("PID"),1:"UNKNOWN")
;
CR ;read for display
S DIR(0)="E" W ! D ^DIR K DIR S:$D(DUOUT)!($D(DTOUT)) DIRUT=1
Q
PAGE ;new page
I DGCRT D CR Q:$D(DIRUT)
W @IOF
D HDR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTOREQ 4081 printed Dec 13, 2024@02:45:06 Page 2
DGMTOREQ ;ALB/TET,CAW,CKN - List Means Test Status ; 5/6/92 ; 07/22/02 11:00am
+1 ;;5.3;Registration;**33,100,166,182,456**;Aug 13, 1993
EN ;Entry point to list required/pending means tests
ST ;select means test status
+1 IF DGMTYPT=1
SET DIC("S")="I ""^R^P^""[$P(^(0),U,2)&($P(^(0),U,19)=DGMTYPT)"
+2 ;Screen Status for Active
IF DGMTYPT=2
SET DIC("S")="I ""^I^P^""[$P(^(0),U,2)&($P(^(0),U,19)=DGMTYPT),$$ACT^DGMTDD(Y,DT)"
SET DIC("B")=9
ST1 SET DIC(0)="AEQMZ"
SET DIC="^DG(408.32,"
+1 SET DIC("A")="Select "_$SELECT(DGMTYPT=1:"MEANS",1:"COPAY")_" TEST STATUS NAME: "
+2 DO ^DIC
KILL DIC
if $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXIT
if Y'>0
GOTO ST
+3 SET DGCAT(+Y)=$PIECE(Y,U,2)
+4 ;
DTB ;select beginning date
+1 SET DIR(0)="DO^::EX"
SET DIR("A")="Enter Beginning Date"
SET DIR("?")="^D HELP^%DTC"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
SET DGBEG=Y
+2 IF DGBEG>DT
WRITE !," Future dates are not allowed.",*7
KILL DGBEG
GOTO DTB
+3 ;select ending date
+4 SET DIR(0)="D^"_DGBEG_":NOW:EX"
SET DIR("A")="Enter Ending Date"
SET DIR("?")="^D HELP^%DTC"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+5 SET DGEND=Y
+6 ;S DGBEG=DGBEG-.1,DGEND=Y_.9
Q ;select device and print
+1 SET DGVAR="DGCAT#^DGBEG^DGEND^DGMTYPT"
SET DGPGM="DQ^DGMTOREQ"
+2 DO ZIS^DGUTQ
if POP
GOTO EXIT
USE IO
DQ ;gather data and print
+1 SET DGC=$ORDER(DGCAT(0))
SET DGCRT=$SELECT($EXTRACT(IOST,1,2)="C-":1,1:0)
+2 SET DGBEGE=$$DATE(DGBEG)
SET DGENDE=$$DATE(DGEND)
SET $PIECE(DGDASH,"=",IOM-1)=""
SET DGPG=0
+3 SET DGC(1)=$SELECT(DGMTYPT=1:"MEANS",1:"COPAY")_" TEST STATUS Report"
SET DGC(2)="STATUS: "_DGCAT(DGC)
+4 SET DGC(3)="From "_DGBEGE_" Through "_DGENDE
+5 ;flag for new column if Means test type is 1 and report selection is for pending means test data
+6 SET CFLG=0
IF (DGMTYPT=1)&(DGC=2)
SET CFLG=1
SORT ;sort data into tmp global
+1 IF '$DATA(^DGMT(408.31,"AS",DGMTYPT,DGC))
SET DGM="No patients found with "_$SELECT(DGMTYPT=1:"means",1:"copay")_" test status of "_DGCAT(DGC)_"."
DO HDR
WRITE !!?10,DGM
GOTO EXIT
+2 SET DGD=-(DGEND+.9)
FOR
SET DGD=$ORDER(^DGMT(408.31,"AS",DGMTYPT,DGC,DGD))
if 'DGD!(DGD>-DGBEG)
QUIT
Begin DoDot:1
+3 SET DFN=0
FOR
SET DFN=$ORDER(^DGMT(408.31,"AS",DGMTYPT,DGC,DGD,DFN))
if 'DFN
QUIT
SET DGSSN=$$PID(DFN)
SET DGDPT0=$GET(^DPT(DFN,0))
IF DGDPT0]""
SET DGNM=$SELECT($PIECE(DGDPT0,U)]"":$PIECE(DGDPT0,U),1:DFN)
Begin DoDot:2
+4 SET DGDA=0
FOR
SET DGDA=$ORDER(^DGMT(408.31,"AS",DGMTYPT,DGC,DGD,DFN,DGDA))
if 'DGDA
QUIT
Begin DoDot:3
+5 if '$GET(^DGMT(408.31,DGDA,"PRIM"))
QUIT
+6 SET DGMT0=$GET(^DGMT(408.31,DGDA,0))
if 'DGMT0
QUIT
+7 SET ^TMP($JOB,"DGMTO",DGNM,DFN,DGDA)=DGSSN_U_$PIECE(DGMT0,U)_U_$$SR^DGMTAUD1(DGMT0)
+8 IF CFLG
Begin DoDot:4
+9 SET PENDA=$$PA^DGMTUTL(DGDA)
+10 SET ^TMP($JOB,"DGMTO",DGNM,DFN,DGDA)=$GET(^TMP($JOB,"DGMTO",DGNM,DFN,DGDA))_U_PENDA
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+11 IF $ORDER(^TMP($JOB,"DGMTO",0))']""
SET DGM="No patients found for requested date range."
DO HDR
WRITE !!?10,DGM
GOTO EXIT
PRINT ;print data from tmp global
+1 DO HDR
+2 SET DGNM=0
FOR
SET DGNM=$ORDER(^TMP($JOB,"DGMTO",DGNM))
if DGNM=""
QUIT
Begin DoDot:1
+3 SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"DGMTO",DGNM,DFN))
if 'DFN
QUIT
Begin DoDot:2
+4 SET DGDA=0
FOR
SET DGDA=$ORDER(^TMP($JOB,"DGMTO",DGNM,DFN,DGDA))
if 'DGDA
QUIT
if $Y+10>IOSL
DO PAGE
if $DATA(DIRUT)
QUIT
Begin DoDot:3
+5 SET DG0=^TMP($JOB,"DGMTO",DGNM,DFN,DGDA)
+6 WRITE !,DGNM,?24,$$PID($PIECE(DG0,U)),?38,$PIECE(DG0,U,3),?54,$$DATE($PIECE(DG0,U,2))
+7 IF CFLG
WRITE ?71,$PIECE(DG0,U,4)
End DoDot:3
End DoDot:2
if $DATA(DIRUT)
QUIT
End DoDot:1
if $DATA(DIRUT)
GOTO EXIT
EXIT ;clean up and quit
+1 IF +$GET(DGCRT)
IF $Y'>(IOSL-10)
DO CR
+2 KILL DFN,DG0,DGBEG,DGBEGE,DGC,DGCAT,DGCRT,DGD,DGDA,DGDPT0,DGDASH,DGEND,DGENDE,DGJ,DGM,DGMT0,DGMTYPT,DGNM,DGPG,DGSSN,DIC,DIR,DTOUT,DUOUT,DIRUT,VAERR,X,Y,PENDA,CFLG
+3 DO CLOSE^DGMTUTL
DO ^%ZISC
+4 KILL ^TMP($JOB)
+5 QUIT
HDR ;header
+1 IF DGPG=0
IF DGCRT
WRITE @IOF
+2 FOR I=1:1:3
WRITE !?(IOM-$LENGTH(DGC(I))/2),DGC(I)
+3 SET DGPG=DGPG+1
WRITE !?66,"Page ",DGPG,!,DGDASH,!
+4 WRITE !?38,$SELECT(DGMTYPT=1:"Means",1:"Copay")_" Test",?56,"Date of"
+5 IF CFLG
WRITE ?67,"Pend. Adj."
+6 WRITE !,"Patient Name",?24,"Patient ID",?40,"Source",?58,"Test"
+7 IF CFLG
WRITE ?69,"Status"
+8 WRITE !,"------------",?24,"----------",?38,"----------",?56,"-------"
+9 IF CFLG
WRITE ?67,"----------"
+10 QUIT
DATE(X) ;function to return date in external format
+1 ;INPUT - FM internal date format
+2 ;OUTPUT - external date format
+3 QUIT $$FMTE^XLFDT($EXTRACT(X,1,12),1)
+4 ;
PID(X) ;function to return pid
+1 ;INPUT - DFN
+2 ;OUTPUT - PID or UNKNOWN
+3 DO PID^VADPT6
+4 QUIT $SELECT(VA("PID")]"":VA("PID"),1:"UNKNOWN")
+5 ;
CR ;read for display
+1 SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
if $DATA(DUOUT)!($DATA(DTOUT))
SET DIRUT=1
+2 QUIT
PAGE ;new page
+1 IF DGCRT
DO CR
if $DATA(DIRUT)
QUIT
+2 WRITE @IOF
+3 DO HDR
+4 QUIT
