source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCSLM.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 6.0 KB
Line 
1GMRCSLM ;SLC/DCM,JFR - List Mgr routine for consult tracking list ;9/8/99 14:52
2 ;;3.0;CONSULT/REQUEST TRACKING;**1,4,14,12,22**;DEC 27, 1997
3EN ; -- main entry point for GMRC CONSULT TRACKING
4 K GMRCOER
5 S GMRCEN=1 K GMRCQUT
6 ;IF Consults
7 I $D(GMRCIS) D I $D(GMRCQUT) K GMRCEN,GMRCIS,GMRCQUT Q
8 .N DIR,DIRUT,DTOUT,DUOUT,Y
9 .S DIR(0)="SB^R:REQUESTING;C:CONSULTING"
10 .S DIR("A")="Are you the Requesting site or the Consulting site"
11 .D ^DIR I $D(DIRUT) S GMRCQUT=1 Q
12 .S GMRCIS=Y
13 D SP K GMRCEN I $D(GMRCQUT) K GMRCQUT Q
14 D EN^VALM("GMRC CONSULT TRACKING")
15 Q
16 ;
17HDR ; -- header code
18 ;override title if IF Consults
19 I $D(GMRCIS) S VALM("TITLE")="IFC Requests: "_$S(GMRCIS="R":"Requesting",1:"Consulting")_" Site"
20 D HDR1 ;format line 1 of header
21 D:$L(GMRCWT) HDR2("")
22 Q
23 ;
24HDR1 ;format VALMHDR(1) with patient information
25 N GMRCX,GMRCX1,GMRCX2,GMRCX3,TIUCWAD,GMRVSTR,X
26 ;Expects DFN
27 S GMRVSTR="WT" D EN6^GMRVUTL
28 S GMRCWT="Wt.(lb): "_$S($L($P(X,U,8)):$P(X,U,8),1:"No Entry")
29 D DEM^GMRCU ;returns GMRCPNM,GMRCSN,GMRCAGE,SEX,GMRCWARD,GMRCRB,GMRCDOB,GMRCWLI
30 S GMRCX1=GMRCPNM_" "_GMRCSN
31 ;
32 S GMRCLOC=+$G(^DIC(42,+GMRCWLI,44))_";SC(" I 'GMRCLOC,'$D(XQAID) S GMRCLOC=""
33 S GMRCX2="" I +$G(GMRCLOC) D
34 . N L S L=$G(^SC(+GMRCLOC,0)),GMRCX2=$P(L,U,2)
35 . S:'$L(GMRCX2) GMRCX2=$E($P(L,U),1,4)
36 S:$L($G(GMRCRB)) GMRCX2=GMRCX2_"/"_GMRCRB
37 ;
38 S GMRCX=GMRCX1_$J(GMRCX2,40+($L(GMRCX2)\2)-$L(GMRCX1))
39 S GMRCX3=" "_GMRCDOB_" ("_GMRCAGE_")"
40 S TIUCWAD=$$CWAD^ORQPT2(+DFN) S:TIUCWAD]"" GMRCX3=GMRCX3_" <"_TIUCWAD_">"
41 S VALMHDR(1)=GMRCX_$J(GMRCX3,79-$L(GMRCX))
42 K VALMHDR(2)
43 Q
44HDR2(GMRCX) ;format VALMHDR(2) with patient weight
45 S VALMHDR(2)=$G(GMRCX)_$J($G(GMRCWT),79-$L($G(GMRCX)))
46 Q
47 ;
48INIT ; -- init variables and list array
49 K ^TMP("GMRCR",$J,"LIST")
50 S DSPLINE=0,DATA="",VALMAR="^TMP(""GMRCR"",$J,""LIST"")"
51 F LINE=1:1:LNCT S DSPLINE=$O(^TMP("GMRCR",$J,"CS",DSPLINE)) Q:DSPLINE=""!(DSPLINE?1A.E) S DATA=^(DSPLINE,0) D SET^VALM10(LINE,DATA)
52 S VALMCNT=LNCT,VALMPGE=1,XQORM("A")="Select Action: "
53 K DSPLINE,DATA,LINE
54 S:$D(^TMP("GMRC",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")
55 Q
56 ;
57HELP ; -- help code
58 N X,DX,DY D FULL^VALM1
59 W !!,"Enter the display number of the item you wish to act on, or select an action."
60 W !!,"If you'd like another view of the consults, enter CV."
61 W !!,"Status key:",!?5,"'a' - active",?27,"'c' - complete",?50,"'dc' - discontinued",!?5,"'p' - pending",?27,"'x' - cancelled",?50,"'pr' - partial results",!?5,"'s' - scheduled",?27,"'e' - expired"
62 W !!,"Enter ?? to see a list of actions available for navigating the list."
63 W !!,"Press <return> to continue ..." R X:DTIME
64 S VALMBCK="R"
65 ; S VALMSG=$$MSG
66 S (DX,DY)=0 X ^%ZOSF("XY")
67 D EXIT^GMRCSLMA("R")
68 Q
69 ;
70EXIT ; -- exit code
71 K ^TMP("GMRCR",$J,"LIST")
72 K VALMCNT,VALMBCK,VALMPGE
73 D ^GMRCREXT
74 Q
75 ;
76PHYEN ;Entry Point When Provider's service is known and only needs to look at consults for that service
77 Q:'$D(DUZ) Q:'$D(^VA(200,DUZ,5)) Q:'$L(^VA(200,DUZ,5))
78 S DIC="^DIC(49,",DIC(0)="MNO",X=^VA(200,DUZ,5) D ^DIC K DIC S GMRCSSNM=$S($L($P(Y,"^",2)):$P(Y,"^",2),1:"") I $L(GMRCSSNM) S GMRCSS=$O(^GMR(123.5,"B",GMRCSSNM,0))
79 S GMRCFL=1 D SP I $D(GMRCQUT),GMRCQUT=1 Q
80 D SPD I $D(GMRCQUT) D END,EXIT Q
81 K GMRCFL
82 D AD^GMRCSLM1
83 I GMRCSSNM'["MEDICINE" D EN^VALM("GMRC CONSULT TRACKING"),END,EXIT Q
84 D EN^VALM("GMRC TRK MEDICINE CONSULTS"),END,EXIT Q
85 Q
86SP ;;Select a new patient and return DFN and GMRCSSNM to display consults and requested Service.
87 I $D(VALM) D FULL^VALM1
88 K GMRCQUT S GMRCDFN1=$S($D(DFN):DFN,1:0)
89 D SELPT^GMRCS I $S($D(GMRCQUT):1,'$D(DFN):1,1:0) S GMRCQUT=1,DFN=GMRCDFN1 G SPK
90 I $D(Y),Y<0&(X["^") S GMRCQUT=1 G SPK
91 I $D(Y),Y<0 S DFN=GMRCDFN1 S GMRCQUT=1 G SPK
92 I $D(GMRC("NMBR")) D RESET^GMRCSLMV(GMRC("NMBR")) K GMRC("NMBR")
93 S GMRCWRD=GMRCWARD
94 I $D(GMRCFL) D SPK Q
95 D ASRV^GMRCASV I $S($D(GMRCQUT):1,$D(DTOUT):1,$D(DUOUT):1,1:0) K DTOUT,DIROUT,DUOUT S (GMRCQUT,GMRCQIT)=1 Q
96 S GMRCSS=GMRCDG,GMRCSSNM=$P(^GMR(123.5,GMRCSS,0),"^",1) S GMRCSTCK=""
97 D EN^GMRCMENU
98SPD ;Enter a date range for serching consults; null entry selects all consults and does not exclude by date
99 D ^GMRCSPD Q:$D(GMRCQUT)
100 I $D(GMRCEN) D SPK Q ;GMRCEN defined if branched to here from EN^GMRCSLM
101 S GMRCOER=0
102 D AD^GMRCSLM1 ;Do not delete. Needed to get new Pt. data into ^TMP("GMRCR",
103 S VALMCNT=LNCT,VALMBCK="R",VALMPGE=1 K GMRCDFN1
104 Q
105SPQ ;New patient has not been selected - keep current patient
106 I '$D(DFN),GMRCDFN1<1 S GMRCQUT=1 K GMRCDFN1 Q
107 S DFN=GMRCDFN1 Q:DFN<1 W " "_GMRCPNM K GMRCDFN1
108 S VALMBCK="R",GMRCQUT=1 K GMRCDFN1
109SPK ;Kill variables
110 ;I $D(GMRCTM),$D(GMRCBM),$D(IOSTBM) S IOTM=GMRCTM,IOBM=IOSTBM
111 K GMRCDFN1,GMRCBM,GMRCTM
112 Q
113SS ;Select A New Service or ALL SERVICES to Display Patient Consults
114 K GMRCQUT,GMRCVP S GMRCOER=0
115 D FULL^VALM1
116 D ASRV^GMRCASV I $D(GMRCQUT),GMRCQUT=1 Q
117 S GMRCSS=GMRCDG,GMRCSSNM=$P(^GMR(123.5,GMRCSS,0),"^",1)
118 D AD^GMRCSLM1,INIT,HDR
119 S VALMBCK="R",VALMCNT=LNCT
120 D EN^GMRCACTM,EN^GMRCMENU
121 I $D(GMRC("NMBR")) D RESET^GMRCSLMV(GMRC("NMBR")) K GMRC("NMBR")
122 Q
123STS ;Select a status for view. i.e., only active, pendings, DC'd, etc.
124 I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
125 S GMRCERR=0
126 N DIR,X,Y
127 S DIR(0)="SAOM^dc:Discontinued;c:Complete;p:Pending;a:Active;pr:Partial Results;s:Scheduled;x:Cancelled"
128 S $P(DIR(0),U,2)="al:All Status's;"_$P(DIR(0),U,2)
129 S DIR("A")="Only Display Consults With Status of: "
130 S DIR("B")="All Status's"
131 I $G(GMRCSTCK) D
132 . S DIR("A")="Another Status to display: "
133 . K DIR("B")
134 D ^DIR
135 I $D(DUOUT)!($D(DTOUT))!('$L(Y)) G END
136 D STCK($$LOW^XLFSTR(Y)) I $G(GMRCSTCK)="" D:$D(GMRC("NMBR")) G END
137 . D RESET^GMRCSLMV(GMRC("NMBR"))
138 . K GMRC("NMBR")
139 . Q
140 I $D(GMRC("NMBR")) D RESET^GMRCSLMV(GMRC("NMBR")) K GMRC("NMBR")
141 G STS
142STCK(RES) ;change code to status
143 N CODE
144 I RES="al" S GMRCSTCK="" Q
145 I RES="dc" S CODE=1
146 I RES="c" S CODE=2
147 I RES="p" S CODE=5
148 I RES="a" S CODE=6
149 I RES="pr" S CODE=9
150 I RES="x" S CODE=13
151 I RES="s" S CODE=8
152 I $D(GMRCSTCK) I $$FND(CODE) W $C(7),!,"Already selected" Q
153 I +$G(GMRCSTCK) S GMRCSTCK=GMRCSTCK_","_CODE Q
154 S GMRCSTCK=CODE
155 Q
156FND(CD) ;status already selected?
157 I GMRCSTCK=CD Q 1
158 I $F(GMRCSTCK,(CD_",")) Q 1
159 I $E(GMRCSTCK,$L(GMRCSTCK))=CD Q 1
160 Q 0
161END K DIR,GMRCERR,Y
162 Q
Note: See TracBrowser for help on using the repository browser.