source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCMCP.m@ 789

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

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1GMRCMCP ;SLC/DLT - List Manager Format Routine To Collect Medicine Package Consults and format them for display by List Manager. ;5/20/98 14:20
2 ;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997
3EN ;;Main List Manager Entry Point To Medicine Package Interface
4 S GMRCFL=1 K GMRCQUT,Y,GMRCOER
5 I +$P($G(^GMR(123.9,1,0)),"^",2) D Q:$D(GMRCQUT)
6 .S DIC="^GMR(123.9,1,123,",DIC("P")=$P(^DD(123.9,2,0),"^",2),DIC("A")="SELECT Division/Site Medical Service: ",DIC(0)="AEMQZ",DA=2,DA(1)=.01
7 .D ^DIC K DIC,DA I $S($D(DTOUT):1,$D(DUOUT):1,Y<1:1,1:0) S GMRCQUT=1 K GMRCFL,DIROUT,DTOUT,DUOUT Q
8 .S (GMRCSS,GMRCSVCN)=$P(Y,"^",2),GMRCSSNM=$P(^GMR(123.5,GMRCSS,0),"^",1)
9 .Q
10 E S GMRCSVCN=2,GMRCSSNM="MEDICINE",GMRCSS=$O(^GMR(123.5,"B",GMRCSSNM,"")) I 'GMRCSS D EXIT S GMRCQUT=1 Q
11 S GMRCDG=GMRCSVCN D SERV1^GMRCASV
12 S Y=$P(^GMR(123.5,GMRCSS,0),"^") I '$L(Y) S GMRCQUT=1 Q
13 D SELPR^GMRCS I $D(GMRCQUT),GMRCQUT D EXIT Q
14 S Y=$P($G(^GMR(123.5,GMRCSS,123)),"^",2) I '$L(Y) D EXIT S GMRCMSG=GMRCSSNM_" Has No Procedures Associated With It!! STOPPING..." D EXAC^GMRCADC(GMRCMSG) K GMRCMSG S GMRCQUT=1 Q
15 S GMRCPRNM=$E($P(^ORD(101,GMRCPR,0),"^",1),7,99),GMRCFLG=1
16 I $D(GMRCFL1) Q
17SP ;Select a patient
18 I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
19 D SP^GMRCSLM I $D(GMRCQUT) D EXIT Q
20 I $D(GMRCPRNM) S GMRC=$O(^ORD(101,"B","GMRCR "_GMRCPRNM,0)),GMRCTYPE="GMRCOR REQUEST"
21 E I $D(GMRCPR) S GMRC=GMRCPR,GMRCTYPE="GMRCOR REQUEST"
22 I $D(GMRC("NMBR")) D RESET^GMRCSLMV(GMRC("NMBR")) K GMRC("NMBR")
23 I $D(GMRC)=1!($D(GMRC)=11),+GMRC D
24 .S GMRCVP=GMRC_";ORD(101,",GMRCNM=$S($D(^ORD(101,GMRC,0)):$P(^(0),"^",2),1:"")
25 .Q
26 I $D(GMRC)=1!($D(GMRC)=11),+GMRC D
27 .S ^TMP("GMRCS",$J,GMRCSS)=GMRCSSNM
28DT K GMRCQUT,GMRCQIT
29 S %DT="AEP",%DT("A")="List From Start Date: ALL DATES// " D ^%DT I Y<1&(X="^") S GMRCQUT=1 D EXIT Q
30 S GMRCDT1=$S(Y>1:$P(Y,"^",1),Y<0:"ALL",1:"") S:Y>0 Y=$P(Y,".",1) W:GMRCDT1="ALL" "ALL CONSULTS"
31 S GMRCDT2=0 I GMRCDT1'="ALL" S %DT="AEP",%DT("A")="List To End Date: " F D ^%DT S GMRCDT2=$S(Y<0:0,1:$P(Y,"^",1)) S:Y>0 Y=$P(Y,".",1) Q:Y>0 I Y<0&(X="^") D EXIT S GMRCQUT=1 Q
32 Q:($D(GMRCQUT))
33 D AD^GMRCSLM1
34EXIT ;Kill off variables
35 I $D(IOTM),$D(IOBM) S VALMBCK="R"
36 K DOC,GMRCBM,GMRCDFNS,GMRCFL1,GMRCFL,GMRCFLG,GMRCQUIT,GMRCRB,GMRCSNM,GMRCSSS,GMRCSTCK,GMRCSVCP,GMRCTYPE,GMRCTM,GMRCTX,GMRCWD,GMRCDG
37 Q
38SPEN ;Entry point for List Manager to select only a patient, not dates or procedures
39 S GMRCFL=1
40 D SP
41 D EXIT Q
42 Q
43ENP ;Entry point to select only a new procedure
44 I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
45 S GMRCFL1=1
46 D EN G:'$D(GMRCPR) EXIT
47 S (GMRCVP,GMRC)=GMRCPR_";ORD(101,",GMRCNM=$S($D(^ORD(101,GMRC,0)):$P(^(0),"^",2),1:"")
48 D DT
49 I $D(GMRC("NMBR")) D RESET^GMRCSLMV(GMRC("NMBR")) K GMRC("NMBR")
50 D EXIT
51 Q
Note: See TracBrowser for help on using the repository browser.