GMRCPC1 ;SLC/dee - List Manager Routine: Collect and display consults by service and status ;1/27/00
;;3.0;CONSULT/REQUEST TRACKING;**7**;DEC 27, 1997
Q
;
ENSTS ;GMRC List Manager Routine -- Second entry point for GMRC PENDING CONSULTS with user selected statuses
S GMRCSTAT=$$STS
I $D(GMRCQUT) D EXIT^GMRCPC Q
D EN^GMRCPC
Q
;
NEWSTS ;
N TEMPSTAT
S TEMPSTAT=GMRCSTAT
S GMRCSTAT=$$STS
S:$D(GMRCQUT) GMRCSTAT=TEMPSTAT
Q
;
STS() ;Select a set of status for view.
I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
N DIR,X,Y,GMRCSTCK
STSAGAIN ;Loop to get another status.
;The following commented line would as for all of the statuses.
;S DIR(0)="SAOM^al:All Status's;ap:All Pending;dc:Discont.;c:Completed;h:On Hold;f:Flagged;p:Pending;a:Active;e:Expired;s:Scheduled;pr:Incomplete;d:Delayed;u:Unreleased;dce:Discont/Ed;x:Cancelled;l:Lapsed;rn:Renewed;':No Status"
S DIR(0)="SAOM^al:All Status's;ap:All Pending;dc:Discont.;c:Completed;p:Pending;a:Active;s:Scheduled;pr:Incomplete;x:Cancelled"
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)) S GMRCQUT=1 G END
I '$L(Y) G END
D STCK($$LOW^XLFSTR(Y))
G:$G(GMRCSTCK)'="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,99" STSAGAIN
END Q $S($D(GMRCSTCK):GMRCSTCK,1:"")
;
STCK(RES) ;change code to status
N CODE
; al:All Status's;dc:Discont.;c:Completed;h:On Hold;f:Flagged;p:Pending;a:Active;e:Expired;s:Scheduled
;;pr:Incomplete;d:Delayed;u:Unreleased;dce:Discont/Ed;x:Cancelled;l:Lapsed;rn:Renewed;':No Status")
CASE ;
I RES="al" S GMRCSTCK="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,99" Q ;All Status's
; display no. file name file abbr.
I RES="ap" D Q
.F CODE=3,4,5,6,8,9,11,99 D CKCODE(CODE) ; All Pending Statuses
I RES="dc" D CKCODE(1) Q ; Discont. 1 DISCONTINUED dc
I RES="c" D CKCODE(2) Q ; Completed 2 COMPLETE c
I RES="h" D CKCODE(3) Q ; On Hold 3 HOLD h
I RES="f" D CKCODE(4) Q ; Flagged 4 FLAGGED "?"
I RES="p" D CKCODE(5) Q ; Pending 5 PENDING p
I RES="a" D CKCODE(6) Q ; Active 6 ACTIVE a
I RES="e" D CKCODE(7) Q ; Expired 7 EXPIRED e
I RES="s" D CKCODE(8) Q ; Scheduled 8 SCHEDULED s
I RES="pr" D CKCODE(9) Q ; Incomplete 9 PARTIAL RESULTS pr
I RES="d" D CKCODE(10) Q ; Delayed 10 DELAYED d
I RES="u" D CKCODE(11) Q ; Unreseased 11 UNRELEASED u
I RES="dce" D CKCODE(12) Q ;Discont/Ed 12 DISCONTINUED/EDIT dce
I RES="x" D CKCODE(13) Q ; Cancelled 13 CANCELLED x
I RES="l" D CKCODE(14) Q ; Lapsed 14 LAPSED l
I RES="rn" D CKCODE(15) Q ; Renewed 15 RENEWED rn
I RES="'" D CKCODE(99) Q ; No Status 99 NO STATUS '
ENDCASE Q
;
CKCODE(CODE) ;
I $D(GMRCSTCK),$$FND(CODE) W $C(7),!,"Already selected" Q
I +$G(GMRCSTCK) S GMRCSTCK=GMRCSTCK_","_CODE
E 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
;
NUMBER ;
I GMRCCTRL'=120 S GMRCCTRL=120
E S GMRCCTRL=0
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCPC1 3362 printed Apr 09, 2024@20:51:55 Page 2
GMRCPC1 ;SLC/dee - List Manager Routine: Collect and display consults by service and status ;1/27/00
+1 ;;3.0;CONSULT/REQUEST TRACKING;**7**;DEC 27, 1997
+2 QUIT
+3 ;
ENSTS ;GMRC List Manager Routine -- Second entry point for GMRC PENDING CONSULTS with user selected statuses
+1 SET GMRCSTAT=$$STS
+2 IF $DATA(GMRCQUT)
DO EXIT^GMRCPC
QUIT
+3 DO EN^GMRCPC
+4 QUIT
+5 ;
NEWSTS ;
+1 NEW TEMPSTAT
+2 SET TEMPSTAT=GMRCSTAT
+3 SET GMRCSTAT=$$STS
+4 if $DATA(GMRCQUT)
SET GMRCSTAT=TEMPSTAT
+5 QUIT
+6 ;
STS() ;Select a set of status for view.
+1 IF $DATA(IOTM)
IF $DATA(IOBM)
IF $DATA(IOSTBM)
DO FULL^VALM1
+2 NEW DIR,X,Y,GMRCSTCK
STSAGAIN ;Loop to get another status.
+1 ;The following commented line would as for all of the statuses.
+2 ;S DIR(0)="SAOM^al:All Status's;ap:All Pending;dc:Discont.;c:Completed;h:On Hold;f:Flagged;p:Pending;a:Active;e:Expired;s:Scheduled;pr:Incomplete;d:Delayed;u:Unreleased;dce:Discont/Ed;x:Cancelled;l:Lapsed;rn:Renewed;':No Status"
+3 SET DIR(0)="SAOM^al:All Status's;ap:All Pending;dc:Discont.;c:Completed;p:Pending;a:Active;s:Scheduled;pr:Incomplete;x:Cancelled"
+4 SET DIR("A")="Only Display Consults With Status of: "
+5 SET DIR("B")="All Status's"
+6 IF $GET(GMRCSTCK)
Begin DoDot:1
+7 SET DIR("A")="Another Status to display: "
+8 KILL DIR("B")
End DoDot:1
+9 DO ^DIR
+10 IF $DATA(DUOUT)!($DATA(DTOUT))
SET GMRCQUT=1
GOTO END
+11 IF '$LENGTH(Y)
GOTO END
+12 DO STCK($$LOW^XLFSTR(Y))
+13 if $GET(GMRCSTCK)'="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,99"
GOTO STSAGAIN
END QUIT $SELECT($DATA(GMRCSTCK):GMRCSTCK,1:"")
+1 ;
STCK(RES) ;change code to status
+1 NEW CODE
+2 ; al:All Status's;dc:Discont.;c:Completed;h:On Hold;f:Flagged;p:Pending;a:Active;e:Expired;s:Scheduled
+3 ;;pr:Incomplete;d:Delayed;u:Unreleased;dce:Discont/Ed;x:Cancelled;l:Lapsed;rn:Renewed;':No Status")
CASE ;
+1 ;All Status's
IF RES="al"
SET GMRCSTCK="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,99"
QUIT
+2 ; display no. file name file abbr.
+3 IF RES="ap"
Begin DoDot:1
+4 ; All Pending Statuses
FOR CODE=3,4,5,6,8,9,11,99
DO CKCODE(CODE)
End DoDot:1
QUIT
+5 ; Discont. 1 DISCONTINUED dc
IF RES="dc"
DO CKCODE(1)
QUIT
+6 ; Completed 2 COMPLETE c
IF RES="c"
DO CKCODE(2)
QUIT
+7 ; On Hold 3 HOLD h
IF RES="h"
DO CKCODE(3)
QUIT
+8 ; Flagged 4 FLAGGED "?"
IF RES="f"
DO CKCODE(4)
QUIT
+9 ; Pending 5 PENDING p
IF RES="p"
DO CKCODE(5)
QUIT
+10 ; Active 6 ACTIVE a
IF RES="a"
DO CKCODE(6)
QUIT
+11 ; Expired 7 EXPIRED e
IF RES="e"
DO CKCODE(7)
QUIT
+12 ; Scheduled 8 SCHEDULED s
IF RES="s"
DO CKCODE(8)
QUIT
+13 ; Incomplete 9 PARTIAL RESULTS pr
IF RES="pr"
DO CKCODE(9)
QUIT
+14 ; Delayed 10 DELAYED d
IF RES="d"
DO CKCODE(10)
QUIT
+15 ; Unreseased 11 UNRELEASED u
IF RES="u"
DO CKCODE(11)
QUIT
+16 ;Discont/Ed 12 DISCONTINUED/EDIT dce
IF RES="dce"
DO CKCODE(12)
QUIT
+17 ; Cancelled 13 CANCELLED x
IF RES="x"
DO CKCODE(13)
QUIT
+18 ; Lapsed 14 LAPSED l
IF RES="l"
DO CKCODE(14)
QUIT
+19 ; Renewed 15 RENEWED rn
IF RES="rn"
DO CKCODE(15)
QUIT
+20 ; No Status 99 NO STATUS '
IF RES="'"
DO CKCODE(99)
QUIT
ENDCASE QUIT
+1 ;
CKCODE(CODE) ;
+1 IF $DATA(GMRCSTCK)
IF $$FND(CODE)
WRITE $CHAR(7),!,"Already selected"
QUIT
+2 IF +$GET(GMRCSTCK)
SET GMRCSTCK=GMRCSTCK_","_CODE
+3 IF '$TEST
SET GMRCSTCK=CODE
+4 QUIT
+5 ;
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
+5 ;
NUMBER ;
+1 IF GMRCCTRL'=120
SET GMRCCTRL=120
+2 IF '$TEST
SET GMRCCTRL=0
+3 QUIT
+4 ;
