- 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 Jan 18, 2025@02:47:53 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 ;