- GMRCONS3 ;ALB/MRY - Consult Status link report ;4/10/06 14:21
- ;;3.0;CONSULT/REQUEST TRACKING;**52**;DEC 27, 1997
- NEWSTS ;
- N TEMPSTAT
- S TEMPSTAT=GMRCSTAT
- S GMRCSTAT=$$STS Q:GMRCSTAT=""
- ;S:$D(GMRCQUT) GMRCSTAT=TEMPSTAT
- D CT3
- 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.
- 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 $D(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))
- I $D(GMRCSTCK),GMRCSTCK'="COM,PEN,ACT,SCH,INC,DSC,CAN" G 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="COM,PEN,ACT,SCH,INC,DSC,CAN" Q ;All Status's
- ; display no. file name file abbr.
- I RES="ap" D Q
- .F CODE="PEN","ACT","SCH","INC" D CKCODE(CODE) ; All Pending Statuses
- I RES="dc" D CKCODE("DSC") Q ; Discont. 1 DISCONTINUED dc
- I RES="c" D CKCODE("COM") Q ; Completed 2 COMPLETE c
- I RES="p" D CKCODE("PEN") Q ; Pending 5 PENDING p
- I RES="a" D CKCODE("ACT") Q ; Active 6 ACTIVE a
- I RES="s" D CKCODE("SCH") Q ; Scheduled 8 SCHEDULED s
- I RES="pr" D CKCODE("INC") Q ; Incomplete 9 PARTIAL RESULTS pr
- I RES="x" D CKCODE("CAN") Q ; Cancelled 13 CANCELLED x
- ENDCASE Q
- ;
- CKCODE(CODE) ;
- I $D(GMRCSTCK),$$FND(CODE) W $C(7),!,"Already selected" Q
- ;I +$G(GMRCSTCK) S GMRCSTCK=GMRCSTCK_","_CODE
- ;I $G(GMRCSTCK) S GMRCSTCK=GMRCSTCK_","_CODE
- I $D(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
- ;
- SUMARY ;
- ;;ACTERAP;Active, By Admin;Active, Edit Re-submit Admin Purpose
- ;;ACTERCC;Active, Can By Clinic;Active, Edit Re-submit, Cancel by Clinic
- ;;ACTERCP;Active, Can By Patient;Active, Edit Re-submit, Cancel by Patient
- ;;ACTERNS;Active, No-Show;Active, Edit Re-submit, No Show
- ;;ACTEROW;Active, Edit Resubmit;Active, Edit Re-submit, Old Way
- ;;ACTWOLHNWL;Active, Manually;Active, Without Link History
- ;;ACTWOLHWL;Active, EWL;Active, Without Link History
- ;;ACTWOLHIFC;Active, IFC;Active, Without Link History
- ;;CANCELED;Cancelled;Cancelled
- ;;COMPLETE;Completed;Completed
- ;;DSCNTUED;Discontinued;Discontinued
- ;;INCMPLTE;Incomplete;Incomplete
- ;;PENNWL;Pending;Pending
- ;;PENWL;Pending, EWL;Pending, Electronic Wait List
- ;;SCHWALCO;Sch, Linked, Ck'd Out;Scheduled, Linked, Checked Out;1
- ;;SCHWALNCO;Scheduled, Linked;Scheduled, Linked;1
- ;;SCHWHNAL;Sch, Not Linked now;Scheduled, Not Linked
- ;;SCHWOLHNWL;Sch, Never Linked;Scheduled, Without Link History
- ;;SCHWOLHWL;Schedule, EWL;Scheduled, Without Link history, wait listed
- ;;SCHWOLHIFC;Schedule, IFC;Scheduled, Without Link history, interfacility consult
- ;;TOC;Total Open Consults;Total Open Consults
- ;;TCC;Total Closed Consults;Total Closed Consults
- ;;
- CT3 ;print clinic summary
- D WAIT^DICD K ^TMP("GMRCR",$J)
- S LN=0,A="" F S A=$O(^TMP($J,"B",A)) Q:A="" D
- .K SUM S HDR="",B="" F S B=$O(^TMP($J,"B",A,B)) Q:B="" D:GMRCSTAT[$E(B,1,3)
- ..I $D(HDR) D HEADER K HDR
- ..S SUM(B)=^TMP($J,"B",A,B)
- ..S CNSDT=0 F S CNSDT=$O(^TMP($J,"B",A,B,CNSDT)) Q:'+CNSDT S CNSLT=0 F S CNSLT=$O(^TMP($J,"B",A,B,CNSDT,CNSLT)) Q:'+CNSLT S CNSLTND=^(CNSLT),PTNM=$P(CNSLTND,U),PRTCNDT=$E(CNSDT,4,5)_"-"_$E(CNSDT,6,7)_"-"_$E(CNSDT,2,3) D
- ...F TX=1:1 S TEXT=$T(SUMARY+TX),P3=$P(TEXT,";",3) Q:P3="" I P3[B S P4=$P(TEXT,";",4),P6=$P(TEXT,";",6) D
- ....I P6=1 I $D(^SC("AWAS1",CNSLT)) D
- .....S CLINIC=$O(^SC("AWAS1",CNSLT,":"),-1),SDAPT=$O(^SC("AWAS1",CNSLT,CLINIC,":"),-1),STCOD=$P(^SC(CLINIC,0),U,7),STCOD=$P(^DIC(40.7,STCOD,0),U,2),CLINIC=$P(^SC(CLINIC,0),U),SDAPT1=$E(SDAPT,4,5)_"-"_$E(SDAPT,6,7)_"-"_$E(SDAPT,2,3)
- .....S Y=SDAPT D DD^%DT S SDAPTIM=$E($P(Y,"@",2),1,5)
- ....S SETNOD=$$SPC(P4,22),SETNOD=SETNOD_PRTCNDT,SETNOD=$$SPC(SETNOD,32),SETNOD=SETNOD_$P(CNSLTND,U,10),SETNOD=$$SPC(SETNOD,37),SETNOD=SETNOD_$P(CNSLTND,U,9),SETNOD=$$SPC(SETNOD,42),SETNOD=SETNOD_$E(PTNM,1,18),SETNOD=$$SPC(SETNOD,63)
- ....D:P6=1 D SETNOD
- .....S SETNOD=SETNOD_$E(CLINIC,1,15),SETNOD=$$SPC(SETNOD,80),SETNOD=SETNOD_SDAPT1_" @ "_SDAPTIM,SETNOD=$$SPC(SETNOD,98),SETNOD=SETNOD_$E(STCOD,1,5)
- .I $D(SUM) S SETNOD=" " D SETNOD D S SETNOD=" " D SETNOD S SETNOD=" " D SETNOD
- ..S I="" F S I=$O(SUM(I)) Q:I="" F II=1:1 S SM=$T(SUMARY+II) S PC3=$P(SM,";",3) Q:PC3="" I I=PC3 S SETNOD=$$SPC(" ",6),SETNOD=SETNOD_$$SPC(SUM(I),6),SETNOD=SETNOD_$P(SM,";",4) D SETNOD Q
- Q
- S SETNOD=A_" "_FR_" - "_TO D SETNOD S SETNOD=$$SPC(" ",22),SETNOD=SETNOD_"Consult",SETNOD=$$SPC(SETNOD,63),SETNOD=SETNOD_"Clinic",SETNOD=$$SPC(SETNOD,80),SETNOD=SETNOD_"Appointment",SETNOD=$$SPC(SETNOD,97),SETNOD=SETNOD_"Stop" D SETNOD
- S SETNOD=$$SPC("Status",22),SETNOD=SETNOD_"Date",SETNOD=$$SPC(SETNOD,32),SETNOD=SETNOD_"SC",SETNOD=$$SPC(SETNOD,37),SETNOD=SETNOD_"L4",SETNOD=$$SPC(SETNOD,42),SETNOD=SETNOD_"Patient",SETNOD=$$SPC(SETNOD,63)
- S SETNOD=SETNOD_"Appointment",SETNOD=$$SPC(SETNOD,80),SETNOD=SETNOD_"Date/time",SETNOD=$$SPC(SETNOD,97),SETNOD=SETNOD_"Code" D SETNOD S SETNOD=DSH D SETNOD
- Q
- SETNOD ;
- S LN=LN+1,^TMP("GMRCR",$J,"CP",LN,0)=SETNOD,SPC="",VALMCNT=LN
- Q
- SPC(DATA,COL) ;
- N SPC S SPC=DATA,L2=COL,L1=$L(DATA) F L3=1:1:(L2-L1) S SPC=SPC_" "
- Q SPC
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCONS3 5997 printed Feb 18, 2025@23:12:46 Page 2
- GMRCONS3 ;ALB/MRY - Consult Status link report ;4/10/06 14:21
- +1 ;;3.0;CONSULT/REQUEST TRACKING;**52**;DEC 27, 1997
- NEWSTS ;
- +1 NEW TEMPSTAT
- +2 SET TEMPSTAT=GMRCSTAT
- +3 SET GMRCSTAT=$$STS
- if GMRCSTAT=""
- QUIT
- +4 ;S:$D(GMRCQUT) GMRCSTAT=TEMPSTAT
- +5 DO CT3
- +6 QUIT
- 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 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"
- +2 SET DIR("A")="Only Display Consults With Status of: "
- +3 SET DIR("B")="All Status's"
- +4 IF $DATA(GMRCSTCK)
- Begin DoDot:1
- +5 SET DIR("A")="Another Status to display: "
- +6 KILL DIR("B")
- End DoDot:1
- +7 DO ^DIR
- +8 IF $DATA(DUOUT)!($DATA(DTOUT))
- SET GMRCQUT=1
- GOTO END
- +9 IF '$LENGTH(Y)
- GOTO END
- +10 DO STCK($$LOW^XLFSTR(Y))
- +11 IF $DATA(GMRCSTCK)
- IF GMRCSTCK'="COM,PEN,ACT,SCH,INC,DSC,CAN"
- 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="COM,PEN,ACT,SCH,INC,DSC,CAN"
- QUIT
- +2 ; display no. file name file abbr.
- +3 IF RES="ap"
- Begin DoDot:1
- +4 ; All Pending Statuses
- FOR CODE="PEN","ACT","SCH","INC"
- DO CKCODE(CODE)
- End DoDot:1
- QUIT
- +5 ; Discont. 1 DISCONTINUED dc
- IF RES="dc"
- DO CKCODE("DSC")
- QUIT
- +6 ; Completed 2 COMPLETE c
- IF RES="c"
- DO CKCODE("COM")
- QUIT
- +7 ; Pending 5 PENDING p
- IF RES="p"
- DO CKCODE("PEN")
- QUIT
- +8 ; Active 6 ACTIVE a
- IF RES="a"
- DO CKCODE("ACT")
- QUIT
- +9 ; Scheduled 8 SCHEDULED s
- IF RES="s"
- DO CKCODE("SCH")
- QUIT
- +10 ; Incomplete 9 PARTIAL RESULTS pr
- IF RES="pr"
- DO CKCODE("INC")
- QUIT
- +11 ; Cancelled 13 CANCELLED x
- IF RES="x"
- DO CKCODE("CAN")
- QUIT
- ENDCASE QUIT
- +1 ;
- CKCODE(CODE) ;
- +1 IF $DATA(GMRCSTCK)
- IF $$FND(CODE)
- WRITE $CHAR(7),!,"Already selected"
- QUIT
- +2 ;I +$G(GMRCSTCK) S GMRCSTCK=GMRCSTCK_","_CODE
- +3 ;I $G(GMRCSTCK) S GMRCSTCK=GMRCSTCK_","_CODE
- +4 IF $DATA(GMRCSTCK)
- SET GMRCSTCK=GMRCSTCK_","_CODE
- +5 IF '$TEST
- SET GMRCSTCK=CODE
- +6 QUIT
- +7 ;
- 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 ;
- SUMARY ;
- +1 ;;ACTERAP;Active, By Admin;Active, Edit Re-submit Admin Purpose
- +2 ;;ACTERCC;Active, Can By Clinic;Active, Edit Re-submit, Cancel by Clinic
- +3 ;;ACTERCP;Active, Can By Patient;Active, Edit Re-submit, Cancel by Patient
- +4 ;;ACTERNS;Active, No-Show;Active, Edit Re-submit, No Show
- +5 ;;ACTEROW;Active, Edit Resubmit;Active, Edit Re-submit, Old Way
- +6 ;;ACTWOLHNWL;Active, Manually;Active, Without Link History
- +7 ;;ACTWOLHWL;Active, EWL;Active, Without Link History
- +8 ;;ACTWOLHIFC;Active, IFC;Active, Without Link History
- +9 ;;CANCELED;Cancelled;Cancelled
- +10 ;;COMPLETE;Completed;Completed
- +11 ;;DSCNTUED;Discontinued;Discontinued
- +12 ;;INCMPLTE;Incomplete;Incomplete
- +13 ;;PENNWL;Pending;Pending
- +14 ;;PENWL;Pending, EWL;Pending, Electronic Wait List
- +15 ;;SCHWALCO;Sch, Linked, Ck'd Out;Scheduled, Linked, Checked Out;1
- +16 ;;SCHWALNCO;Scheduled, Linked;Scheduled, Linked;1
- +17 ;;SCHWHNAL;Sch, Not Linked now;Scheduled, Not Linked
- +18 ;;SCHWOLHNWL;Sch, Never Linked;Scheduled, Without Link History
- +19 ;;SCHWOLHWL;Schedule, EWL;Scheduled, Without Link history, wait listed
- +20 ;;SCHWOLHIFC;Schedule, IFC;Scheduled, Without Link history, interfacility consult
- +21 ;;TOC;Total Open Consults;Total Open Consults
- +22 ;;TCC;Total Closed Consults;Total Closed Consults
- +23 ;;
- CT3 ;print clinic summary
- +1 DO WAIT^DICD
- KILL ^TMP("GMRCR",$JOB)
- +2 SET LN=0
- SET A=""
- FOR
- SET A=$ORDER(^TMP($JOB,"B",A))
- if A=""
- QUIT
- Begin DoDot:1
- +3 KILL SUM
- SET HDR=""
- SET B=""
- FOR
- SET B=$ORDER(^TMP($JOB,"B",A,B))
- if B=""
- QUIT
- if GMRCSTAT[$EXTRACT(B,1,3)
- Begin DoDot:2
- +4 IF $DATA(HDR)
- DO HEADER
- KILL HDR
- +5 SET SUM(B)=^TMP($JOB,"B",A,B)
- +6 SET CNSDT=0
- FOR
- SET CNSDT=$ORDER(^TMP($JOB,"B",A,B,CNSDT))
- if '+CNSDT
- QUIT
- SET CNSLT=0
- FOR
- SET CNSLT=$ORDER(^TMP($JOB,"B",A,B,CNSDT,CNSLT))
- if '+CNSLT
- QUIT
- SET CNSLTND=^(CNSLT)
- SET PTNM=$PIECE(CNSLTND,U)
- SET PRTCNDT=$EXTRACT(CNSDT,4,5)_"-"_$EXTRACT(CNSDT,6,7)_"-"_$EXTRACT(CNSDT,2,3)
- Begin DoDot:3
- +7 FOR TX=1:1
- SET TEXT=$TEXT(SUMARY+TX)
- SET P3=$PIECE(TEXT,";",3)
- if P3=""
- QUIT
- IF P3[B
- SET P4=$PIECE(TEXT,";",4)
- SET P6=$PIECE(TEXT,";",6)
- Begin DoDot:4
- +8 IF P6=1
- IF $DATA(^SC("AWAS1",CNSLT))
- Begin DoDot:5
- +9 SET CLINIC=$ORDER(^SC("AWAS1",CNSLT,":"),-1)
- SET SDAPT=$ORDER(^SC("AWAS1",CNSLT,CLINIC,":"),-1)
- SET STCOD=$PIECE(^SC(CLINIC,0),U,7)
- SET STCOD=$PIECE(^DIC(40.7,STCOD,0),U,2)
- SET CLINIC=$PIECE(^SC(CLINIC,0),U)
- SET SDAPT1=$EXTRACT(SDAPT,4,5)_"-"_$EXTRACT(SDAPT,6,7)_"-"_$EXTRACT(SDAPT,2,3)
- +10 SET Y=SDAPT
- DO DD^%DT
- SET SDAPTIM=$EXTRACT($PIECE(Y,"@",2),1,5)
- End DoDot:5
- +11 SET SETNOD=$$SPC(P4,22)
- SET SETNOD=SETNOD_PRTCNDT
- SET SETNOD=$$SPC(SETNOD,32)
- SET SETNOD=SETNOD_$PIECE(CNSLTND,U,10)
- SET SETNOD=$$SPC(SETNOD,37)
- SET SETNOD=SETNOD_$PIECE(CNSLTND,U,9)
- SET SETNOD=$$SPC(SETNOD,42)
- SET SETNOD=SETNOD_$EXTRACT(PTNM,1,18)
- SET SETNOD=$$SPC(SETNOD,63)
- +12 if P6=1
- Begin DoDot:5
- +13 SET SETNOD=SETNOD_$EXTRACT(CLINIC,1,15)
- SET SETNOD=$$SPC(SETNOD,80)
- SET SETNOD=SETNOD_SDAPT1_" @ "_SDAPTIM
- SET SETNOD=$$SPC(SETNOD,98)
- SET SETNOD=SETNOD_$EXTRACT(STCOD,1,5)
- End DoDot:5
- DO SETNOD
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +14 IF $DATA(SUM)
- SET SETNOD=" "
- DO SETNOD
- Begin DoDot:2
- +15 SET I=""
- FOR
- SET I=$ORDER(SUM(I))
- if I=""
- QUIT
- FOR II=1:1
- SET SM=$TEXT(SUMARY+II)
- SET PC3=$PIECE(SM,";",3)
- if PC3=""
- QUIT
- IF I=PC3
- SET SETNOD=$$SPC(" ",6)
- SET SETNOD=SETNOD_$$SPC(SUM(I),6)
- SET SETNOD=SETNOD_$PIECE(SM,";",4)
- DO SETNOD
- QUIT
- End DoDot:2
- SET SETNOD=" "
- DO SETNOD
- SET SETNOD=" "
- DO SETNOD
- End DoDot:1
- +16 QUIT
- +1 SET SETNOD=A_" "_FR_" - "_TO
- DO SETNOD
- SET SETNOD=$$SPC(" ",22)
- SET SETNOD=SETNOD_"Consult"
- SET SETNOD=$$SPC(SETNOD,63)
- SET SETNOD=SETNOD_"Clinic"
- SET SETNOD=$$SPC(SETNOD,80)
- SET SETNOD=SETNOD_"Appointment"
- SET SETNOD=$$SPC(SETNOD,97)
- SET SETNOD=SETNOD_"Stop"
- DO SETNOD
- +2 SET SETNOD=$$SPC("Status",22)
- SET SETNOD=SETNOD_"Date"
- SET SETNOD=$$SPC(SETNOD,32)
- SET SETNOD=SETNOD_"SC"
- SET SETNOD=$$SPC(SETNOD,37)
- SET SETNOD=SETNOD_"L4"
- SET SETNOD=$$SPC(SETNOD,42)
- SET SETNOD=SETNOD_"Patient"
- SET SETNOD=$$SPC(SETNOD,63)
- +3 SET SETNOD=SETNOD_"Appointment"
- SET SETNOD=$$SPC(SETNOD,80)
- SET SETNOD=SETNOD_"Date/time"
- SET SETNOD=$$SPC(SETNOD,97)
- SET SETNOD=SETNOD_"Code"
- DO SETNOD
- SET SETNOD=DSH
- DO SETNOD
- +4 QUIT
- SETNOD ;
- +1 SET LN=LN+1
- SET ^TMP("GMRCR",$JOB,"CP",LN,0)=SETNOD
- SET SPC=""
- SET VALMCNT=LN
- +2 QUIT
- SPC(DATA,COL) ;
- +1 NEW SPC
- SET SPC=DATA
- SET L2=COL
- SET L1=$LENGTH(DATA)
- FOR L3=1:1:(L2-L1)
- SET SPC=SPC_" "
- +2 QUIT SPC
- +3 QUIT