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
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
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997
EN ;;Main List Manager Entry Point To Medicine Package Interface
+1 SET GMRCFL=1
KILL GMRCQUT,Y,GMRCOER
+2 IF +$PIECE($GET(^GMR(123.9,1,0)),"^",2)
Begin DoDot:1
+3 SET DIC="^GMR(123.9,1,123,"
SET DIC("P")=$PIECE(^DD(123.9,2,0),"^",2)
SET DIC("A")="SELECT Division/Site Medical Service: "
SET DIC(0)="AEMQZ"
SET DA=2
SET DA(1)=.01
+4 DO ^DIC
KILL DIC,DA
IF $SELECT($DATA(DTOUT):1,$DATA(DUOUT):1,Y<1:1,1:0)
SET GMRCQUT=1
KILL GMRCFL,DIROUT,DTOUT,DUOUT
QUIT
+5 SET (GMRCSS,GMRCSVCN)=$PIECE(Y,"^",2)
SET GMRCSSNM=$PIECE(^GMR(123.5,GMRCSS,0),"^",1)
+6 QUIT
End DoDot:1
IF $DATA(GMRCQUT)
QUIT
+7 IF '$TEST
SET GMRCSVCN=2
SET GMRCSSNM="MEDICINE"
SET GMRCSS=$ORDER(^GMR(123.5,"B",GMRCSSNM,""))
IF 'GMRCSS
DO EXIT
SET GMRCQUT=1
QUIT
+8 SET GMRCDG=GMRCSVCN
DO SERV1^GMRCASV
+9 SET Y=$PIECE(^GMR(123.5,GMRCSS,0),"^")
IF '$LENGTH(Y)
SET GMRCQUT=1
QUIT
+10 DO SELPR^GMRCS
IF $DATA(GMRCQUT)
IF GMRCQUT
DO EXIT
QUIT
+11 SET Y=$PIECE($GET(^GMR(123.5,GMRCSS,123)),"^",2)
IF '$LENGTH(Y)
DO EXIT
SET GMRCMSG=GMRCSSNM_" Has No Procedures Associated With It!! STOPPING..."
DO EXAC^GMRCADC(GMRCMSG)
KILL GMRCMSG
SET GMRCQUT=1
QUIT
+12 SET GMRCPRNM=$EXTRACT($PIECE(^ORD(101,GMRCPR,0),"^",1),7,99)
SET GMRCFLG=1
+13 IF $DATA(GMRCFL1)
QUIT
SP ;Select a patient
+1 IF $DATA(IOTM)
IF $DATA(IOBM)
IF $DATA(IOSTBM)
DO FULL^VALM1
+2 DO SP^GMRCSLM
IF $DATA(GMRCQUT)
DO EXIT
QUIT
+3 IF $DATA(GMRCPRNM)
SET GMRC=$ORDER(^ORD(101,"B","GMRCR "_GMRCPRNM,0))
SET GMRCTYPE="GMRCOR REQUEST"
+4 IF '$TEST
IF $DATA(GMRCPR)
SET GMRC=GMRCPR
SET GMRCTYPE="GMRCOR REQUEST"
+5 IF $DATA(GMRC("NMBR"))
DO RESET^GMRCSLMV(GMRC("NMBR"))
KILL GMRC("NMBR")
+6 IF $DATA(GMRC)=1!($DATA(GMRC)=11)
IF +GMRC
Begin DoDot:1
+7 SET GMRCVP=GMRC_";ORD(101,"
SET GMRCNM=$SELECT($DATA(^ORD(101,GMRC,0)):$PIECE(^(0),"^",2),1:"")
+8 QUIT
End DoDot:1
+9 IF $DATA(GMRC)=1!($DATA(GMRC)=11)
IF +GMRC
Begin DoDot:1
+10 SET ^TMP("GMRCS",$JOB,GMRCSS)=GMRCSSNM
End DoDot:1
DT KILL GMRCQUT,GMRCQIT
+1 SET %DT="AEP"
SET %DT("A")="List From Start Date: ALL DATES// "
DO ^%DT
IF Y<1&(X="^")
SET GMRCQUT=1
DO EXIT
QUIT
+2 SET GMRCDT1=$SELECT(Y>1:$PIECE(Y,"^",1),Y<0:"ALL",1:"")
IF Y>0
SET Y=$PIECE(Y,".",1)
IF GMRCDT1="ALL"
WRITE "ALL CONSULTS"
+3 SET GMRCDT2=0
IF GMRCDT1'="ALL"
SET %DT="AEP"
SET %DT("A")="List To End Date: "
FOR
DO ^%DT
SET GMRCDT2=$SELECT(Y<0:0,1:$PIECE(Y,"^",1))
IF Y>0
SET Y=$PIECE(Y,".",1)
IF Y>0
QUIT
IF Y<0&(X="^")
DO EXIT
SET GMRCQUT=1
QUIT
+4 IF ($DATA(GMRCQUT))
QUIT
+5 DO AD^GMRCSLM1
EXIT ;Kill off variables
+1 IF $DATA(IOTM)
IF $DATA(IOBM)
SET VALMBCK="R"
+2 KILL DOC,GMRCBM,GMRCDFNS,GMRCFL1,GMRCFL,GMRCFLG,GMRCQUIT,GMRCRB,GMRCSNM,GMRCSSS,GMRCSTCK,GMRCSVCP,GMRCTYPE,GMRCTM,GMRCTX,GMRCWD,GMRCDG
+3 QUIT
SPEN ;Entry point for List Manager to select only a patient, not dates or procedures
+1 SET GMRCFL=1
+2 DO SP
+3 DO EXIT
QUIT
+4 QUIT
ENP ;Entry point to select only a new procedure
+1 IF $DATA(IOTM)
IF $DATA(IOBM)
IF $DATA(IOSTBM)
DO FULL^VALM1
+2 SET GMRCFL1=1
+3 DO EN
IF '$DATA(GMRCPR)
GOTO EXIT
+4 SET (GMRCVP,GMRC)=GMRCPR_";ORD(101,"
SET GMRCNM=$SELECT($DATA(^ORD(101,GMRC,0)):$PIECE(^(0),"^",2),1:"")
+5 DO DT
+6 IF $DATA(GMRC("NMBR"))
DO RESET^GMRCSLMV(GMRC("NMBR"))
KILL GMRC("NMBR")
+7 DO EXIT
+8 QUIT
