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

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

initial load of WorldVistAEHR

File size: 4.7 KB
RevLine 
[613]1DGPREP0 ;Boise/WRL/ALB/SCK-Program to Display Pre-Registration List ; 2/24/04 2:11pm
2 ;;5.3;Registration;**109,546,586,581**;Aug 13, 1993
3 Q
4 ;
5EN ; -- main entry point
6 N VAUTD,X1
7 ;
8 I '$D(^XUSEC("DGPRE EDIT",DUZ))&('$D(^XUSEC("DGPRE SUPV",DUZ))) D G ENQ
9 . W !!,"You do not have the requisite key allocated, contact your Supervisor."
10 ; *** Select Divisions
11 I $P($G(^DG(43,1,"GL")),U,2) D
12 . D DIVISION^VAUTOMA
13 E D
14 . S DGSNGLDV=1
15 . S VAUTD=1
16 ;
17 D EN^VALM("DGPRE RG")
18ENQ Q
19 ;
20HDR ; -- header code
21 ; Variables
22 ; DGPSRT - Sort Method for call list display
23 ;
24 N DGPSRT
25 I $D(VAUTD) S VALMHDR(1)="Call List sorted by Division and then "
26 S DGPSRT=$P($G(^DG(43,1,"DGPRE")),U)
27 S VALMHDR(1)=$G(VALMHDR(1))_"Sorted by "_$S(DGPSRT="P":"Patient Name",DGPSRT="S":"Medical Service")_"."
28 I $G(VAUTD) S VALMHDR(2)="All Divisions selected."
29 Q
30 ;
31INIT ; -- Retrieve data from call list and build TMP global for sorting Call lsit
32 ; Variables
33 ; DGPNR -
34 ; DGPDATA - 0 Node from ^DGS(41.42,X
35 ; DGPDATA1 - 1 Node from ^DGS(41.42,X
36 ; DGPDIV - Division IEN from ^DGS(41.42,
37 ; DGPDVN - Division Name
38 ; DGPSV - Medical Service for appointment clinic
39 ; DGPAT - Appt. date/time
40 ; DGPPN - Patients name
41 ; DGPNR - Index No. for LM
42 ; DGPSRT - Call list sort method
43 ; DGPN0,DGPN1,DGPNX - Local Var's for $O
44 ;
45 N DGQ,DGPDATA,DGPDATA1,DGPDIV,DGPDVN,DGPNX,DGPN1,DGPN2
46 ;
47 K ^TMP("DGPRERG",$J)
48 K ^TMP($J)
49 S DGPSRT=$P($G(^DG(43,1,"DGPRE")),U)
50 I $P($G(^DGS(41.42,0)),U,4)>1 W !!,"Sorting Entries..."
51 ;
52 S DGPN1=0 F S DGPN1=$O(^DGS(41.42,DGPN1)) Q:'DGPN1 D
53 . S DGPDATA=$G(^DGS(41.42,DGPN1,0)),DGPDATA1=$G(^DGS(41.42,DGPN1,1))
54 . Q:DGPDATA']""!(DGPDATA1']"")
55 . ; **** Division handling
56 . S DGPDIV=$P(DGPDATA,U,2)
57 . I +DGPDIV'>0 D
58 .. I $G(DGSNGLDV) S DGPDIV=$S($D(^DG(40.8,1)):1,1:0) Q
59 .. S DGPDIV=-1
60 . K DGQ
61 . I '$G(DGSNGLDV) D Q:$G(DGQ)
62 .. I '$G(VAUTD),'$D(VAUTD(DGPDIV)) S DGQ=1
63 . ;
64 . S DGPSV=$P(DGPDATA1,U)
65 . S DGPAT=$P(DGPDATA,U,8)
66 . S DGPPN=$P(^DPT($P(^DGS(41.42,DGPN1,0),U),0),U)
67 . ;
68 . I DGPSRT="S" D
69 .. I DGPSV']"" W !,"NO SERVICE ENTRY FOR RECORD# ",DGPN1 Q
70 .. S ^TMP($J,DGPDIV,DGPSV,DGPN1)=$P(^DGS(41.42,DGPN1,0),U)
71 . ;
72 . I DGPSRT="P" D
73 .. I DGPPN']"" W !,"NO PATIENT ENTRY FOR RECORD# ",DGPN1 Q
74 .. S ^TMP($J,DGPDIV,DGPPN,DGPN1)=$P($G(^DGS(41.42,DGPN1,0)),U)
75 . ;
76 . I DGPSRT']"" D
77 .. I DGPPN']"" W !,"NO PATIENT ENTRY FOR RECORD# ",DGPN1 Q
78 .. S ^TMP($J,DGPDIV,DGPPN,DGPN1)=$P(^DGS(41.42,DGPN1,0),U)
79 . W "."
80 ;
81 I $D(^TMP($J)) W !!,"Loading Sorted Entries into List..."
82 E D
83 . W *7,!!,"No appointments were found for the selected divisions"
84 . K DIR S DIR(0)="E" D ^DIR K DIR
85 ;
86 ; Retreive sorted call list form ^TMP and build LM arrays
87 ;
88 S DGPNR=1
89 S DGPN0="" F S DGPN0=$O(^TMP($J,DGPN0)) Q:DGPN0="" D
90 . S DGPN1="" F S DGPN1=$O(^TMP($J,DGPN0,DGPN1)) Q:DGPN1="" D
91 .. S DGPNX="" F S DGPNX=$O(^TMP($J,DGPN0,DGPN1,DGPNX)) Q:DGPNX="" D
92 ... S DGPDATA=$G(^DGS(41.42,DGPNX,0))
93 ... S DGPDATA1=$G(^DGS(41.42,DGPNX,1))
94 ... S DGPSV=$P(DGPDATA1,U)
95 ... S X=$$SETFLD^VALM1(DGPNR,"","INDEX")
96 ... S X=$$SETFLD^VALM1($E($P(^DPT($P(DGPDATA,U),0),U),1,30),X,"PATIENT")
97 ... S DGPDFN=$P(DGPDATA,U)
98 ... D BLDHIST
99 ... S X=$$SETFLD^VALM1($P(DGPDATA1,U,2),X,"SSN")
100 ... S X=$$SETFLD^VALM1(DGPSV,X,"SVC")
101 ... S X=$$SETFLD^VALM1($E($P(DGPDATA1,U,3),1,18),X,"PHONE")
102 ... S X=$$SETFLD^VALM1($$FMTE^XLFDT($P(DGPDATA,U,5),"2D"),X,"LAST")
103 ... I $P(DGPDATA,U,6)="Y" D
104 .... ;S X=$$SETFLD^VALM1("*",X,"CALL")
105 ... S DGPDVN=$S(+$G(DGPN0)>0:$P(^DG(40.8,DGPN0,0),U),DGPN0<0:"",1:DGPN0)
106 ... S X=$$SETFLD^VALM1($E(DGPDVN,1,20),X,"DIVISION")
107 ... S ^TMP("DGPRERG",$J,DGPNR,0)=X
108 ... S ^TMP("DGPRERG",$J,"DA",DGPNR,DGPN1)=""
109 ... S ^TMP("DGPRERG",$J,"DFN",DGPNR,DGPDFN)=""
110 ... S ^TMP("DGPRERG",$J,"SSN",DGPNR,$P(DGPDATA1,U,2))=""
111 ... S ^TMP("DGPRERG",$J,"IDX",DGPNR,DGPNR)=""
112 ... S ^TMP("DGPRERG",$J,"DIV",DGPNR,DGPN0)=""
113 ... S DGPNR=DGPNR+1
114 ... W "."
115 S VALMCNT=DGPNR-1
116 I VALMCNT'>0 S VALMQUIT=1
117 Q
118 ;
119HELP ; -- help code
120 S X="?" D DISP^XQORM1 W !!
121 Q
122 ;
123EXIT ; -- Exit code
124 K ^TMP("DGPRERG",$J)
125 K DGPAT,DGPCH,DGPCL,DGPDA,DGPDATA,DGPDATA1,DGPDFN,DGPEDIT,DGPENT,DGPFLG,DGPIFN
126 K DGPLOC,DGPN0,DGPN1,DGPN2,DGPN3,DGPNR,DGPP1,DGPP2,DGPP3,DGPPN
127 K DGPPSRT,DGPST,DGPSV,DGPTAT,DA,X,Y,DIR,DIC,DIE
128 D FULL^VALM1
129 D CLEAN^VALM10
130 Q
131 ;
132BLDHIST ; Build history of call attempts from ^DGS(41.43, Call log
133 N DGPN2,DGPN3
134 ;
135 S DGPN2=0 F S DGPN2=$O(^DGS(41.43,"C",DGPDFN,DGPN2)) Q:'DGPN2 D
136 . S:$P(^DGS(41.43,DGPN2,0),U,4)]"" ^TMP("STAT",$J,$P(^DGS(41.43,DGPN2,0),U,1))=$P(^DGS(41.43,DGPN2,0),U,4)
137 I $D(^TMP("STAT",$J)) D
138 . S DGPTAT=""
139 . S DGPN3=9999999.999999 F S DGPN3=$O(^TMP("STAT",$J,DGPN3),-1) Q:'DGPN3 D
140 .. S DGPTAT=DGPTAT_^TMP("STAT",$J,DGPN3)
141 . S X=$$SETFLD^VALM1(DGPTAT,X,"HIST")
142 . K ^TMP("STAT",$J)
143 Q
Note: See TracBrowser for help on using the repository browser.