Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRCMCP

GMRCMCP.m

Go to the documentation of this file.
GMRCMCP ;SLC/DLT - List Manager Format Routine To Collect Medicine Package Consults and format them for display by List Manager. ;5/20/98  14:20
 ;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997
EN ;;Main List Manager Entry Point To Medicine Package Interface
 S GMRCFL=1 K GMRCQUT,Y,GMRCOER
 I +$P($G(^GMR(123.9,1,0)),"^",2) D   Q:$D(GMRCQUT)
 .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
 .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
 .S (GMRCSS,GMRCSVCN)=$P(Y,"^",2),GMRCSSNM=$P(^GMR(123.5,GMRCSS,0),"^",1)
 .Q
 E  S GMRCSVCN=2,GMRCSSNM="MEDICINE",GMRCSS=$O(^GMR(123.5,"B",GMRCSSNM,"")) I 'GMRCSS D EXIT S GMRCQUT=1 Q
 S GMRCDG=GMRCSVCN D SERV1^GMRCASV
 S Y=$P(^GMR(123.5,GMRCSS,0),"^") I '$L(Y) S GMRCQUT=1 Q
 D SELPR^GMRCS I $D(GMRCQUT),GMRCQUT D EXIT Q
 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
 S GMRCPRNM=$E($P(^ORD(101,GMRCPR,0),"^",1),7,99),GMRCFLG=1
 I $D(GMRCFL1) Q
SP ;Select a patient
 I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
 D SP^GMRCSLM I $D(GMRCQUT) D EXIT Q
 I $D(GMRCPRNM) S GMRC=$O(^ORD(101,"B","GMRCR "_GMRCPRNM,0)),GMRCTYPE="GMRCOR REQUEST"
 E  I $D(GMRCPR) S GMRC=GMRCPR,GMRCTYPE="GMRCOR REQUEST"
 I $D(GMRC("NMBR")) D RESET^GMRCSLMV(GMRC("NMBR")) K GMRC("NMBR")
 I $D(GMRC)=1!($D(GMRC)=11),+GMRC D
 .S GMRCVP=GMRC_";ORD(101,",GMRCNM=$S($D(^ORD(101,GMRC,0)):$P(^(0),"^",2),1:"")
 .Q
 I $D(GMRC)=1!($D(GMRC)=11),+GMRC D
 .S ^TMP("GMRCS",$J,GMRCSS)=GMRCSSNM
DT K GMRCQUT,GMRCQIT
 S %DT="AEP",%DT("A")="List From Start Date: ALL DATES// " D ^%DT I Y<1&(X="^") S GMRCQUT=1 D EXIT Q
 S GMRCDT1=$S(Y>1:$P(Y,"^",1),Y<0:"ALL",1:"") S:Y>0 Y=$P(Y,".",1) W:GMRCDT1="ALL" "ALL CONSULTS"
 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
 Q:($D(GMRCQUT))
 D AD^GMRCSLM1
EXIT ;Kill off variables
 I $D(IOTM),$D(IOBM) S VALMBCK="R"
 K DOC,GMRCBM,GMRCDFNS,GMRCFL1,GMRCFL,GMRCFLG,GMRCQUIT,GMRCRB,GMRCSNM,GMRCSSS,GMRCSTCK,GMRCSVCP,GMRCTYPE,GMRCTM,GMRCTX,GMRCWD,GMRCDG
 Q
SPEN ;Entry point for List Manager to select only a patient, not dates or procedures
 S GMRCFL=1
 D SP
 D EXIT Q
 Q
ENP ;Entry point to select only a new procedure
 I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
 S GMRCFL1=1
 D EN G:'$D(GMRCPR) EXIT
 S (GMRCVP,GMRC)=GMRCPR_";ORD(101,",GMRCNM=$S($D(^ORD(101,GMRC,0)):$P(^(0),"^",2),1:"")
 D DT
 I $D(GMRC("NMBR")) D RESET^GMRCSLMV(GMRC("NMBR")) K GMRC("NMBR")
 D EXIT
 Q