- 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
