source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMTOREQ.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: 3.9 KB
RevLine 
[613]1DGMTOREQ ;ALB/TET,CAW,CKN - List Means Test Status ; 5/6/92 ; 07/22/02 11:00am
2 ;;5.3;Registration;**33,100,166,182,456**;Aug 13, 1993
3EN ;Entry point to list required/pending means tests
4ST ;select means test status
5 I DGMTYPT=1 S DIC("S")="I ""^R^P^""[$P(^(0),U,2)&($P(^(0),U,19)=DGMTYPT)"
6 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
7ST1 S DIC(0)="AEQMZ",DIC="^DG(408.32,"
8 S DIC("A")="Select "_$S(DGMTYPT=1:"MEANS",1:"COPAY")_" TEST STATUS NAME: "
9 D ^DIC K DIC G:$D(DTOUT)!($D(DUOUT)) EXIT G:Y'>0 ST
10 S DGCAT(+Y)=$P(Y,U,2)
11 ;
12DTB ;select beginning date
13 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
14 I DGBEG>DT W !," Future dates are not allowed.",*7 K DGBEG G DTB
15 ;select ending date
16 S DIR(0)="D^"_DGBEG_":NOW:EX",DIR("A")="Enter Ending Date",DIR("?")="^D HELP^%DTC" D ^DIR K DIR G:$D(DIRUT) EXIT
17 S DGEND=Y
18 ;S DGBEG=DGBEG-.1,DGEND=Y_.9
19Q ;select device and print
20 S DGVAR="DGCAT#^DGBEG^DGEND^DGMTYPT",DGPGM="DQ^DGMTOREQ"
21 D ZIS^DGUTQ G EXIT:POP U IO
22DQ ;gather data and print
23 S DGC=$O(DGCAT(0)),DGCRT=$S($E(IOST,1,2)="C-":1,1:0)
24 S DGBEGE=$$DATE(DGBEG),DGENDE=$$DATE(DGEND),$P(DGDASH,"=",IOM-1)="",DGPG=0
25 S DGC(1)=$S(DGMTYPT=1:"MEANS",1:"COPAY")_" TEST STATUS Report",DGC(2)="STATUS: "_DGCAT(DGC)
26 S DGC(3)="From "_DGBEGE_" Through "_DGENDE
27 ;flag for new column if Means test type is 1 and report selection is for pending means test data
28 S CFLG=0 I (DGMTYPT=1)&(DGC=2) S CFLG=1
29SORT ;sort data into tmp global
30 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
31 S DGD=-(DGEND+.9) F S DGD=$O(^DGMT(408.31,"AS",DGMTYPT,DGC,DGD)) Q:'DGD!(DGD>-DGBEG) D
32 .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
33 ..S DGDA=0 F S DGDA=$O(^DGMT(408.31,"AS",DGMTYPT,DGC,DGD,DFN,DGDA)) Q:'DGDA D
34 ...Q:'$G(^DGMT(408.31,DGDA,"PRIM"))
35 ...S DGMT0=$G(^DGMT(408.31,DGDA,0)) Q:'DGMT0
36 ...S ^TMP($J,"DGMTO",DGNM,DFN,DGDA)=DGSSN_U_$P(DGMT0,U)_U_$$SR^DGMTAUD1(DGMT0)
37 ...I CFLG D
38 ....S PENDA=$$PA^DGMTUTL(DGDA)
39 ....S ^TMP($J,"DGMTO",DGNM,DFN,DGDA)=$G(^TMP($J,"DGMTO",DGNM,DFN,DGDA))_U_PENDA
40 I $O(^TMP($J,"DGMTO",0))']"" S DGM="No patients found for requested date range." D HDR W !!?10,DGM G EXIT
41PRINT ;print data from tmp global
42 D HDR
43 S DGNM=0 F S DGNM=$O(^TMP($J,"DGMTO",DGNM)) Q:DGNM="" D G:$D(DIRUT) EXIT
44 .S DFN=0 F S DFN=$O(^TMP($J,"DGMTO",DGNM,DFN)) Q:'DFN D Q:$D(DIRUT)
45 ..S DGDA=0 F S DGDA=$O(^TMP($J,"DGMTO",DGNM,DFN,DGDA)) Q:'DGDA D:$Y+10>IOSL PAGE Q:$D(DIRUT) D
46 ...S DG0=^TMP($J,"DGMTO",DGNM,DFN,DGDA)
47 ...W !,DGNM,?24,$$PID($P(DG0,U)),?38,$P(DG0,U,3),?54,$$DATE($P(DG0,U,2))
48 ...I CFLG W ?71,$P(DG0,U,4)
49EXIT ;clean up and quit
50 I +$G(DGCRT),$Y'>(IOSL-10) D CR
51 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
52 D CLOSE^DGMTUTL,^%ZISC
53 K ^TMP($J)
54 Q
55HDR ;header
56 I DGPG=0,DGCRT W @IOF
57 F I=1:1:3 W !?(IOM-$L(DGC(I))/2),DGC(I)
58 S DGPG=DGPG+1 W !?66,"Page ",DGPG,!,DGDASH,!
59 W !?38,$S(DGMTYPT=1:"Means",1:"Copay")_" Test",?56,"Date of"
60 I CFLG W ?67,"Pend. Adj."
61 W !,"Patient Name",?24,"Patient ID",?40,"Source",?58,"Test"
62 I CFLG W ?69,"Status"
63 W !,"------------",?24,"----------",?38,"----------",?56,"-------"
64 I CFLG W ?67,"----------"
65 Q
66DATE(X) ;function to return date in external format
67 ;INPUT - FM internal date format
68 ;OUTPUT - external date format
69 Q $$FMTE^XLFDT($E(X,1,12),1)
70 ;
71PID(X) ;function to return pid
72 ;INPUT - DFN
73 ;OUTPUT - PID or UNKNOWN
74 D PID^VADPT6
75 Q $S(VA("PID")]"":VA("PID"),1:"UNKNOWN")
76 ;
77CR ;read for display
78 S DIR(0)="E" W ! D ^DIR K DIR S:$D(DUOUT)!($D(DTOUT)) DIRUT=1
79 Q
80PAGE ;new page
81 I DGCRT D CR Q:$D(DIRUT)
82 W @IOF
83 D HDR
84 Q
Note: See TracBrowser for help on using the repository browser.