- GMRCSLM ;SLC/DCM,JFR - List Mgr routine for consult tracking list ;9/8/99 14:52
- ;;3.0;CONSULT/REQUEST TRACKING;**1,4,14,12,22**;DEC 27, 1997
- EN ; -- main entry point for GMRC CONSULT TRACKING
- K GMRCOER
- S GMRCEN=1 K GMRCQUT
- ;IF Consults
- I $D(GMRCIS) D I $D(GMRCQUT) K GMRCEN,GMRCIS,GMRCQUT Q
- .N DIR,DIRUT,DTOUT,DUOUT,Y
- .S DIR(0)="SB^R:REQUESTING;C:CONSULTING"
- .S DIR("A")="Are you the Requesting site or the Consulting site"
- .D ^DIR I $D(DIRUT) S GMRCQUT=1 Q
- .S GMRCIS=Y
- D SP K GMRCEN I $D(GMRCQUT) K GMRCQUT Q
- D EN^VALM("GMRC CONSULT TRACKING")
- Q
- ;
- HDR ; -- header code
- ;override title if IF Consults
- I $D(GMRCIS) S VALM("TITLE")="IFC Requests: "_$S(GMRCIS="R":"Requesting",1:"Consulting")_" Site"
- D HDR1 ;format line 1 of header
- D:$L(GMRCWT) HDR2("")
- Q
- ;
- HDR1 ;format VALMHDR(1) with patient information
- N GMRCX,GMRCX1,GMRCX2,GMRCX3,TIUCWAD,GMRVSTR,X
- ;Expects DFN
- S GMRVSTR="WT" D EN6^GMRVUTL
- S GMRCWT="Wt.(lb): "_$S($L($P(X,U,8)):$P(X,U,8),1:"No Entry")
- D DEM^GMRCU ;returns GMRCPNM,GMRCSN,GMRCAGE,SEX,GMRCWARD,GMRCRB,GMRCDOB,GMRCWLI
- S GMRCX1=GMRCPNM_" "_GMRCSN
- ;
- S GMRCLOC=+$G(^DIC(42,+GMRCWLI,44))_";SC(" I 'GMRCLOC,'$D(XQAID) S GMRCLOC=""
- S GMRCX2="" I +$G(GMRCLOC) D
- . N L S L=$G(^SC(+GMRCLOC,0)),GMRCX2=$P(L,U,2)
- . S:'$L(GMRCX2) GMRCX2=$E($P(L,U),1,4)
- S:$L($G(GMRCRB)) GMRCX2=GMRCX2_"/"_GMRCRB
- ;
- S GMRCX=GMRCX1_$J(GMRCX2,40+($L(GMRCX2)\2)-$L(GMRCX1))
- S GMRCX3=" "_GMRCDOB_" ("_GMRCAGE_")"
- S TIUCWAD=$$CWAD^ORQPT2(+DFN) S:TIUCWAD]"" GMRCX3=GMRCX3_" <"_TIUCWAD_">"
- S VALMHDR(1)=GMRCX_$J(GMRCX3,79-$L(GMRCX))
- K VALMHDR(2)
- Q
- HDR2(GMRCX) ;format VALMHDR(2) with patient weight
- S VALMHDR(2)=$G(GMRCX)_$J($G(GMRCWT),79-$L($G(GMRCX)))
- Q
- ;
- INIT ; -- init variables and list array
- K ^TMP("GMRCR",$J,"LIST")
- S DSPLINE=0,DATA="",VALMAR="^TMP(""GMRCR"",$J,""LIST"")"
- 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)
- S VALMCNT=LNCT,VALMPGE=1,XQORM("A")="Select Action: "
- K DSPLINE,DATA,LINE
- S:$D(^TMP("GMRC",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")
- Q
- ;
- HELP ; -- help code
- N X,DX,DY D FULL^VALM1
- W !!,"Enter the display number of the item you wish to act on, or select an action."
- W !!,"If you'd like another view of the consults, enter CV."
- 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"
- W !!,"Enter ?? to see a list of actions available for navigating the list."
- W !!,"Press <return> to continue ..." R X:DTIME
- S VALMBCK="R"
- ; S VALMSG=$$MSG
- S (DX,DY)=0 X ^%ZOSF("XY")
- D EXIT^GMRCSLMA("R")
- Q
- ;
- EXIT ; -- exit code
- K ^TMP("GMRCR",$J,"LIST")
- K VALMCNT,VALMBCK,VALMPGE
- D ^GMRCREXT
- Q
- ;
- PHYEN ;Entry Point When Provider's service is known and only needs to look at consults for that service
- Q:'$D(DUZ) Q:'$D(^VA(200,DUZ,5)) Q:'$L(^VA(200,DUZ,5))
- 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))
- S GMRCFL=1 D SP I $D(GMRCQUT),GMRCQUT=1 Q
- D SPD I $D(GMRCQUT) D END,EXIT Q
- K GMRCFL
- D AD^GMRCSLM1
- I GMRCSSNM'["MEDICINE" D EN^VALM("GMRC CONSULT TRACKING"),END,EXIT Q
- D EN^VALM("GMRC TRK MEDICINE CONSULTS"),END,EXIT Q
- Q
- SP ;;Select a new patient and return DFN and GMRCSSNM to display consults and requested Service.
- I $D(VALM) D FULL^VALM1
- K GMRCQUT S GMRCDFN1=$S($D(DFN):DFN,1:0)
- D SELPT^GMRCS I $S($D(GMRCQUT):1,'$D(DFN):1,1:0) S GMRCQUT=1,DFN=GMRCDFN1 G SPK
- I $D(Y),Y<0&(X["^") S GMRCQUT=1 G SPK
- I $D(Y),Y<0 S DFN=GMRCDFN1 S GMRCQUT=1 G SPK
- I $D(GMRC("NMBR")) D RESET^GMRCSLMV(GMRC("NMBR")) K GMRC("NMBR")
- S GMRCWRD=GMRCWARD
- I $D(GMRCFL) D SPK Q
- 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
- S GMRCSS=GMRCDG,GMRCSSNM=$P(^GMR(123.5,GMRCSS,0),"^",1) S GMRCSTCK=""
- D EN^GMRCMENU
- SPD ;Enter a date range for serching consults; null entry selects all consults and does not exclude by date
- D ^GMRCSPD Q:$D(GMRCQUT)
- I $D(GMRCEN) D SPK Q ;GMRCEN defined if branched to here from EN^GMRCSLM
- S GMRCOER=0
- D AD^GMRCSLM1 ;Do not delete. Needed to get new Pt. data into ^TMP("GMRCR",
- S VALMCNT=LNCT,VALMBCK="R",VALMPGE=1 K GMRCDFN1
- Q
- SPQ ;New patient has not been selected - keep current patient
- I '$D(DFN),GMRCDFN1<1 S GMRCQUT=1 K GMRCDFN1 Q
- S DFN=GMRCDFN1 Q:DFN<1 W " "_GMRCPNM K GMRCDFN1
- S VALMBCK="R",GMRCQUT=1 K GMRCDFN1
- SPK ;Kill variables
- ;I $D(GMRCTM),$D(GMRCBM),$D(IOSTBM) S IOTM=GMRCTM,IOBM=IOSTBM
- K GMRCDFN1,GMRCBM,GMRCTM
- Q
- SS ;Select A New Service or ALL SERVICES to Display Patient Consults
- K GMRCQUT,GMRCVP S GMRCOER=0
- D FULL^VALM1
- D ASRV^GMRCASV I $D(GMRCQUT),GMRCQUT=1 Q
- S GMRCSS=GMRCDG,GMRCSSNM=$P(^GMR(123.5,GMRCSS,0),"^",1)
- D AD^GMRCSLM1,INIT,HDR
- S VALMBCK="R",VALMCNT=LNCT
- D EN^GMRCACTM,EN^GMRCMENU
- I $D(GMRC("NMBR")) D RESET^GMRCSLMV(GMRC("NMBR")) K GMRC("NMBR")
- Q
- STS ;Select a status for view. i.e., only active, pendings, DC'd, etc.
- I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
- S GMRCERR=0
- N DIR,X,Y
- S DIR(0)="SAOM^dc:Discontinued;c:Complete;p:Pending;a:Active;pr:Partial Results;s:Scheduled;x:Cancelled"
- S $P(DIR(0),U,2)="al:All Status's;"_$P(DIR(0),U,2)
- S DIR("A")="Only Display Consults With Status of: "
- S DIR("B")="All Status's"
- I $G(GMRCSTCK) D
- . S DIR("A")="Another Status to display: "
- . K DIR("B")
- D ^DIR
- I $D(DUOUT)!($D(DTOUT))!('$L(Y)) G END
- D STCK($$LOW^XLFSTR(Y)) I $G(GMRCSTCK)="" D:$D(GMRC("NMBR")) G END
- . D RESET^GMRCSLMV(GMRC("NMBR"))
- . K GMRC("NMBR")
- . Q
- I $D(GMRC("NMBR")) D RESET^GMRCSLMV(GMRC("NMBR")) K GMRC("NMBR")
- G STS
- STCK(RES) ;change code to status
- N CODE
- I RES="al" S GMRCSTCK="" Q
- I RES="dc" S CODE=1
- I RES="c" S CODE=2
- I RES="p" S CODE=5
- I RES="a" S CODE=6
- I RES="pr" S CODE=9
- I RES="x" S CODE=13
- I RES="s" S CODE=8
- I $D(GMRCSTCK) I $$FND(CODE) W $C(7),!,"Already selected" Q
- I +$G(GMRCSTCK) S GMRCSTCK=GMRCSTCK_","_CODE Q
- S GMRCSTCK=CODE
- Q
- FND(CD) ;status already selected?
- I GMRCSTCK=CD Q 1
- I $F(GMRCSTCK,(CD_",")) Q 1
- I $E(GMRCSTCK,$L(GMRCSTCK))=CD Q 1
- Q 0
- END K DIR,GMRCERR,Y
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCSLM 6352 printed Jan 18, 2025@02:48:22 Page 2
- GMRCSLM ;SLC/DCM,JFR - List Mgr routine for consult tracking list ;9/8/99 14:52
- +1 ;;3.0;CONSULT/REQUEST TRACKING;**1,4,14,12,22**;DEC 27, 1997
- EN ; -- main entry point for GMRC CONSULT TRACKING
- +1 KILL GMRCOER
- +2 SET GMRCEN=1
- KILL GMRCQUT
- +3 ;IF Consults
- +4 IF $DATA(GMRCIS)
- Begin DoDot:1
- +5 NEW DIR,DIRUT,DTOUT,DUOUT,Y
- +6 SET DIR(0)="SB^R:REQUESTING;C:CONSULTING"
- +7 SET DIR("A")="Are you the Requesting site or the Consulting site"
- +8 DO ^DIR
- IF $DATA(DIRUT)
- SET GMRCQUT=1
- QUIT
- +9 SET GMRCIS=Y
- End DoDot:1
- IF $DATA(GMRCQUT)
- KILL GMRCEN,GMRCIS,GMRCQUT
- QUIT
- +10 DO SP
- KILL GMRCEN
- IF $DATA(GMRCQUT)
- KILL GMRCQUT
- QUIT
- +11 DO EN^VALM("GMRC CONSULT TRACKING")
- +12 QUIT
- +13 ;
- HDR ; -- header code
- +1 ;override title if IF Consults
- +2 IF $DATA(GMRCIS)
- SET VALM("TITLE")="IFC Requests: "_$SELECT(GMRCIS="R":"Requesting",1:"Consulting")_" Site"
- +3 ;format line 1 of header
- DO HDR1
- +4 if $LENGTH(GMRCWT)
- DO HDR2("")
- +5 QUIT
- +6 ;
- HDR1 ;format VALMHDR(1) with patient information
- +1 NEW GMRCX,GMRCX1,GMRCX2,GMRCX3,TIUCWAD,GMRVSTR,X
- +2 ;Expects DFN
- +3 SET GMRVSTR="WT"
- DO EN6^GMRVUTL
- +4 SET GMRCWT="Wt.(lb): "_$SELECT($LENGTH($PIECE(X,U,8)):$PIECE(X,U,8),1:"No Entry")
- +5 ;returns GMRCPNM,GMRCSN,GMRCAGE,SEX,GMRCWARD,GMRCRB,GMRCDOB,GMRCWLI
- DO DEM^GMRCU
- +6 SET GMRCX1=GMRCPNM_" "_GMRCSN
- +7 ;
- +8 SET GMRCLOC=+$GET(^DIC(42,+GMRCWLI,44))_";SC("
- IF 'GMRCLOC
- IF '$DATA(XQAID)
- SET GMRCLOC=""
- +9 SET GMRCX2=""
- IF +$GET(GMRCLOC)
- Begin DoDot:1
- +10 NEW L
- SET L=$GET(^SC(+GMRCLOC,0))
- SET GMRCX2=$PIECE(L,U,2)
- +11 if '$LENGTH(GMRCX2)
- SET GMRCX2=$EXTRACT($PIECE(L,U),1,4)
- End DoDot:1
- +12 if $LENGTH($GET(GMRCRB))
- SET GMRCX2=GMRCX2_"/"_GMRCRB
- +13 ;
- +14 SET GMRCX=GMRCX1_$JUSTIFY(GMRCX2,40+($LENGTH(GMRCX2)\2)-$LENGTH(GMRCX1))
- +15 SET GMRCX3=" "_GMRCDOB_" ("_GMRCAGE_")"
- +16 SET TIUCWAD=$$CWAD^ORQPT2(+DFN)
- if TIUCWAD]""
- SET GMRCX3=GMRCX3_" <"_TIUCWAD_">"
- +17 SET VALMHDR(1)=GMRCX_$JUSTIFY(GMRCX3,79-$LENGTH(GMRCX))
- +18 KILL VALMHDR(2)
- +19 QUIT
- HDR2(GMRCX) ;format VALMHDR(2) with patient weight
- +1 SET VALMHDR(2)=$GET(GMRCX)_$JUSTIFY($GET(GMRCWT),79-$LENGTH($GET(GMRCX)))
- +2 QUIT
- +3 ;
- INIT ; -- init variables and list array
- +1 KILL ^TMP("GMRCR",$JOB,"LIST")
- +2 SET DSPLINE=0
- SET DATA=""
- SET VALMAR="^TMP(""GMRCR"",$J,""LIST"")"
- +3 FOR LINE=1:1:LNCT
- SET DSPLINE=$ORDER(^TMP("GMRCR",$JOB,"CS",DSPLINE))
- if DSPLINE=""!(DSPLINE?1A.E)
- QUIT
- SET DATA=^(DSPLINE,0)
- DO SET^VALM10(LINE,DATA)
- +4 SET VALMCNT=LNCT
- SET VALMPGE=1
- SET XQORM("A")="Select Action: "
- +5 KILL DSPLINE,DATA,LINE
- +6 if $DATA(^TMP("GMRC",$JOB,"CURRENT","MENU"))
- SET XQORM("HIJACK")=^("MENU")
- +7 QUIT
- +8 ;
- HELP ; -- help code
- +1 NEW X,DX,DY
- DO FULL^VALM1
- +2 WRITE !!,"Enter the display number of the item you wish to act on, or select an action."
- +3 WRITE !!,"If you'd like another view of the consults, enter CV."
- +4 WRITE !!,"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"
- +5 WRITE !!,"Enter ?? to see a list of actions available for navigating the list."
- +6 WRITE !!,"Press <return> to continue ..."
- READ X:DTIME
- +7 SET VALMBCK="R"
- +8 ; S VALMSG=$$MSG
- +9 SET (DX,DY)=0
- XECUTE ^%ZOSF("XY")
- +10 DO EXIT^GMRCSLMA("R")
- +11 QUIT
- +12 ;
- EXIT ; -- exit code
- +1 KILL ^TMP("GMRCR",$JOB,"LIST")
- +2 KILL VALMCNT,VALMBCK,VALMPGE
- +3 DO ^GMRCREXT
- +4 QUIT
- +5 ;
- PHYEN ;Entry Point When Provider's service is known and only needs to look at consults for that service
- +1 if '$DATA(DUZ)
- QUIT
- if '$DATA(^VA(200,DUZ,5))
- QUIT
- if '$LENGTH(^VA(200,DUZ,5))
- QUIT
- +2 SET DIC="^DIC(49,"
- SET DIC(0)="MNO"
- SET X=^VA(200,DUZ,5)
- DO ^DIC
- KILL DIC
- SET GMRCSSNM=$SELECT($LENGTH($PIECE(Y,"^",2)):$PIECE(Y,"^",2),1:"")
- IF $LENGTH(GMRCSSNM)
- SET GMRCSS=$ORDER(^GMR(123.5,"B",GMRCSSNM,0))
- +3 SET GMRCFL=1
- DO SP
- IF $DATA(GMRCQUT)
- IF GMRCQUT=1
- QUIT
- +4 DO SPD
- IF $DATA(GMRCQUT)
- DO END
- DO EXIT
- QUIT
- +5 KILL GMRCFL
- +6 DO AD^GMRCSLM1
- +7 IF GMRCSSNM'["MEDICINE"
- DO EN^VALM("GMRC CONSULT TRACKING")
- DO END
- DO EXIT
- QUIT
- +8 DO EN^VALM("GMRC TRK MEDICINE CONSULTS")
- DO END
- DO EXIT
- QUIT
- +9 QUIT
- SP ;;Select a new patient and return DFN and GMRCSSNM to display consults and requested Service.
- +1 IF $DATA(VALM)
- DO FULL^VALM1
- +2 KILL GMRCQUT
- SET GMRCDFN1=$SELECT($DATA(DFN):DFN,1:0)
- +3 DO SELPT^GMRCS
- IF $SELECT($DATA(GMRCQUT):1,'$DATA(DFN):1,1:0)
- SET GMRCQUT=1
- SET DFN=GMRCDFN1
- GOTO SPK
- +4 IF $DATA(Y)
- IF Y<0&(X["^")
- SET GMRCQUT=1
- GOTO SPK
- +5 IF $DATA(Y)
- IF Y<0
- SET DFN=GMRCDFN1
- SET GMRCQUT=1
- GOTO SPK
- +6 IF $DATA(GMRC("NMBR"))
- DO RESET^GMRCSLMV(GMRC("NMBR"))
- KILL GMRC("NMBR")
- +7 SET GMRCWRD=GMRCWARD
- +8 IF $DATA(GMRCFL)
- DO SPK
- QUIT
- +9 DO ASRV^GMRCASV
- IF $SELECT($DATA(GMRCQUT):1,$DATA(DTOUT):1,$DATA(DUOUT):1,1:0)
- KILL DTOUT,DIROUT,DUOUT
- SET (GMRCQUT,GMRCQIT)=1
- QUIT
- +10 SET GMRCSS=GMRCDG
- SET GMRCSSNM=$PIECE(^GMR(123.5,GMRCSS,0),"^",1)
- SET GMRCSTCK=""
- +11 DO EN^GMRCMENU
- SPD ;Enter a date range for serching consults; null entry selects all consults and does not exclude by date
- +1 DO ^GMRCSPD
- if $DATA(GMRCQUT)
- QUIT
- +2 ;GMRCEN defined if branched to here from EN^GMRCSLM
- IF $DATA(GMRCEN)
- DO SPK
- QUIT
- +3 SET GMRCOER=0
- +4 ;Do not delete. Needed to get new Pt. data into ^TMP("GMRCR",
- DO AD^GMRCSLM1
- +5 SET VALMCNT=LNCT
- SET VALMBCK="R"
- SET VALMPGE=1
- KILL GMRCDFN1
- +6 QUIT
- SPQ ;New patient has not been selected - keep current patient
- +1 IF '$DATA(DFN)
- IF GMRCDFN1<1
- SET GMRCQUT=1
- KILL GMRCDFN1
- QUIT
- +2 SET DFN=GMRCDFN1
- if DFN<1
- QUIT
- WRITE " "_GMRCPNM
- KILL GMRCDFN1
- +3 SET VALMBCK="R"
- SET GMRCQUT=1
- KILL GMRCDFN1
- SPK ;Kill variables
- +1 ;I $D(GMRCTM),$D(GMRCBM),$D(IOSTBM) S IOTM=GMRCTM,IOBM=IOSTBM
- +2 KILL GMRCDFN1,GMRCBM,GMRCTM
- +3 QUIT
- SS ;Select A New Service or ALL SERVICES to Display Patient Consults
- +1 KILL GMRCQUT,GMRCVP
- SET GMRCOER=0
- +2 DO FULL^VALM1
- +3 DO ASRV^GMRCASV
- IF $DATA(GMRCQUT)
- IF GMRCQUT=1
- QUIT
- +4 SET GMRCSS=GMRCDG
- SET GMRCSSNM=$PIECE(^GMR(123.5,GMRCSS,0),"^",1)
- +5 DO AD^GMRCSLM1
- DO INIT
- DO HDR
- +6 SET VALMBCK="R"
- SET VALMCNT=LNCT
- +7 DO EN^GMRCACTM
- DO EN^GMRCMENU
- +8 IF $DATA(GMRC("NMBR"))
- DO RESET^GMRCSLMV(GMRC("NMBR"))
- KILL GMRC("NMBR")
- +9 QUIT
- STS ;Select a status for view. i.e., only active, pendings, DC'd, etc.
- +1 IF $DATA(IOTM)
- IF $DATA(IOBM)
- IF $DATA(IOSTBM)
- DO FULL^VALM1
- +2 SET GMRCERR=0
- +3 NEW DIR,X,Y
- +4 SET DIR(0)="SAOM^dc:Discontinued;c:Complete;p:Pending;a:Active;pr:Partial Results;s:Scheduled;x:Cancelled"
- +5 SET $PIECE(DIR(0),U,2)="al:All Status's;"_$PIECE(DIR(0),U,2)
- +6 SET DIR("A")="Only Display Consults With Status of: "
- +7 SET DIR("B")="All Status's"
- +8 IF $GET(GMRCSTCK)
- Begin DoDot:1
- +9 SET DIR("A")="Another Status to display: "
- +10 KILL DIR("B")
- End DoDot:1
- +11 DO ^DIR
- +12 IF $DATA(DUOUT)!($DATA(DTOUT))!('$LENGTH(Y))
- GOTO END
- +13 DO STCK($$LOW^XLFSTR(Y))
- IF $GET(GMRCSTCK)=""
- if $DATA(GMRC("NMBR"))
- Begin DoDot:1
- +14 DO RESET^GMRCSLMV(GMRC("NMBR"))
- +15 KILL GMRC("NMBR")
- +16 QUIT
- End DoDot:1
- GOTO END
- +17 IF $DATA(GMRC("NMBR"))
- DO RESET^GMRCSLMV(GMRC("NMBR"))
- KILL GMRC("NMBR")
- +18 GOTO STS
- STCK(RES) ;change code to status
- +1 NEW CODE
- +2 IF RES="al"
- SET GMRCSTCK=""
- QUIT
- +3 IF RES="dc"
- SET CODE=1
- +4 IF RES="c"
- SET CODE=2
- +5 IF RES="p"
- SET CODE=5
- +6 IF RES="a"
- SET CODE=6
- +7 IF RES="pr"
- SET CODE=9
- +8 IF RES="x"
- SET CODE=13
- +9 IF RES="s"
- SET CODE=8
- +10 IF $DATA(GMRCSTCK)
- IF $$FND(CODE)
- WRITE $CHAR(7),!,"Already selected"
- QUIT
- +11 IF +$GET(GMRCSTCK)
- SET GMRCSTCK=GMRCSTCK_","_CODE
- QUIT
- +12 SET GMRCSTCK=CODE
- +13 QUIT
- FND(CD) ;status already selected?
- +1 IF GMRCSTCK=CD
- QUIT 1
- +2 IF $FIND(GMRCSTCK,(CD_","))
- QUIT 1
- +3 IF $EXTRACT(GMRCSTCK,$LENGTH(GMRCSTCK))=CD
- QUIT 1
- +4 QUIT 0
- END KILL DIR,GMRCERR,Y
- +1 QUIT