- GMRCONS2 ;ALB/MRY - Consult/Scheduling link report ;4/10/06 14:21
- ;;3.0;CONSULT/REQUEST TRACKING;**52**;DEC 27, 1997
- ;
- ;Continued from GMRCONS1
- D SUMARY,CT,SUMARY2,CT2
- S SETNOD=" " D SETNOD S SETNOD=" " D SETNOD S SETNOD="End of report." D SETNOD
- ;
- VALM S VALMHDR(1)="Service: "_SRVNM
- S SETNOD=$$SPC("Status",21),SETNOD=SETNOD_"Date",SETNOD=$$SPC(SETNOD,31),SETNOD=SETNOD_"SC",SETNOD=$$SPC(SETNOD,36),SETNOD=SETNOD_"L4",SETNOD=$$SPC(SETNOD,41),SETNOD=SETNOD_"Patient",SETNOD=$$SPC(SETNOD,62)
- S SETNOD=SETNOD_"Appointment",SETNOD=$$SPC(SETNOD,79),SETNOD=SETNOD_"Date/Time",SETNOD=$$SPC(SETNOD,97)
- D CHGCAP^VALM("CAPTION LINE",SETNOD)
- Q
- ;
- SUMARY ;Create the "A" x-ref
- ;;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 EWL
- ;;ACTWOLHIFC;Active, IFC;Active, Without Link History IFC
- ;;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
- ;;
- F A=1:1 S B=$T(SUMARY+A) Q:$P(B,";",3)="" S ^TMP($J,"A",$P(B,";",3))=0
- S ST="" F S ST=$O(^TMP($J,"S",ST)) Q:ST="" D K WL
- .S AD=0 F S AD=$O(^TMP($J,"S",ST,AD)) Q:'+AD S CS=0 F S CS=$O(^TMP($J,"S",ST,AD,CS)) Q:'+CS S TND=^(CS),PTNM=$P(TND,U),PTIEN=$P(TND,U,2),LSTACT=$P(TND,U,3),AWAS1=$P(TND,U,4),AHST1=$P(TND,U,5),SRV=$P(TND,U,6) D K WL
- ..S STPCLNC="",SC=0 F S SC=$O(^GMR(123.5,SRV,688,SC)) Q:'+SC S STPCOD=$P(^GMR(123.5,SRV,688,SC,0),U) I STPCOD'="" S STPCLNC=$P(^DIC(40.7,STPCOD,0),U)_","_STPCLNC
- ..I ST="ACTIVE" D ACTIVE,TOC
- ..I ST="SCHEDULED" D SCHEDULE,TOC
- ..I ST="PENDING" D PENDING,TOC
- ..I ST="PARTIAL RESULTS" D INCMPLTE,KILNODE,TOC
- ..I ST="CANCELLED" D CANCELED,KILNODE,TCC
- ..I ST="DISCONTINUED" D DSCNTUED,KILNODE,TCC
- ..I ST="COMPLETE" D COMPLETE,KILNODE,TCC
- Q
- ACTIVE D ACTIVE^GMRCONS1 Q
- SCHEDULE D SCHEDULE^GMRCONS1 Q
- PENDING D PENDING^GMRCONS1 Q
- INCMPLTE D INCMPLTE^GMRCONS1 Q
- CANCELED D CANCELED^GMRCONS1 Q
- DSCNTUED D DSCNTUED^GMRCONS1 Q
- COMPLETE D COMPLETE^GMRCONS1 Q
- TOC D TOC^GMRCONS1 Q
- TCC D TCC^GMRCONS1 Q
- KILNODE D KILNODE^GMRCONS1 Q
- ;
- CT ;whole summary
- S LN=0,WDTH=102,PG=1,$P(DSH,"=",WDTH)="",FR=$E(PSD,4,5)_"/"_$E(PSD,6,7)_"/"_$E(PSD,2,3),TO=$E(ED,4,5)_"/"_$E(ED,6,7)_"/"_$E(ED,2,3),PD=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
- S SETNOD="SUMMARY From: "_FR_" To "_TO,SETNOD=$$SPC(SETNOD,93),SETNOD=SETNOD_PD D SETNOD
- S SETNOD=DSH D SETNOD S SETNOD=" " D SETNOD
- S PG=PG+1,BB=$O(^TMP($J,"A","")),SUBTOT=0
- S B="",SUM2=0,SUM=0 F S B=$O(^TMP($J,"A",B)) Q:B="" S TOT=^(B) I TOT'=0 D:B'="COMPLETE"&(B'="CANCELED")&(B'="DSCNTUED")&(B'="TOC")&(B'="TCC")
- .F TX=1:1 S TEXT=$T(SUMARY+TX),P3=$P(TEXT,";",3) Q:P3="" I P3[B S SUM=SUM+TOT,SUBTOT=SUBTOT+TOT,SETNOD=" "_$J(TOT,6)_" "_$P(TEXT,";",4) D SETNOD Q
- S SUM2=SUM2+SUM,SETNOD="----------" D SETNOD S SETNOD=$$SPC(" "_$J(SUM,6),12),SETNOD=SETNOD_"Total OPEN consults" D SETNOD S SETNOD=" " D SETNOD
- S B="",SUM=0 F S B=$O(^TMP($J,"A",B)) Q:B="" S TOT=^(B) I TOT'=0 D:B="COMPLETE"!(B="CANCELED")!(B="DSCNTUED")
- .F TX=1:1 S TEXT=$T(SUMARY+TX),P3=$P(TEXT,";",3) Q:P3="" I P3[B S SUM=SUM+TOT,SETNOD=" "_$J(TOT,6)_" "_$P(TEXT,";",4) D SETNOD Q
- S SUM2=SUM2+SUM,SETNOD="----------" D SETNOD S SETNOD=$$SPC(" "_$J(SUM,6),12),SETNOD=SETNOD_"Total CLOSED consults" D SETNOD S SETNOD=" " D SETNOD
- S SETNOD="==========" D SETNOD S SETNOD=$$SPC(" "_$J(SUM2,6),12),SETNOD=SETNOD_"GRAND TOTAL" D SETNOD S SETNOD=" " D SETNOD
- 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
- SETNOD ;
- S LN=LN+1,^TMP("GMRCR",$J,"CP",LN,0)=SETNOD,SPC="",VALMCNT=LN
- Q
- CT2 ;print clinic summary
- S A="" F S A=$O(^TMP($J,"B",A)) Q:A="" S PG=PG+1 D
- .S SETNOD=" " D SETNOD
- .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
- .S PG=PG+1,SUM=0,B="" F S B=$O(^TMP($J,"B",A,B)) Q:B="" S TOT=^(B) I TOT'=0 D:B'="COMPLETE"&(B'="CANCELED")&(B'="DSCNTUED")&(B'="TOC")&(B'="TCC")
- ..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 SUM=SUM+TOT
- .....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)
- .S SETNOD=" " D SETNOD
- .S BB=$O(^TMP($J,"B",A,"")),SUBTOT=0,SUM2=0,SUM=0,B="" F S B=$O(^TMP($J,"B",A,B)) Q:B="" S TOT=^(B) I TOT'=0 D:B'="COMPLETE"&(B'="CANCELED")&(B'="DSCNTUED")&(B'="TOC")&(B'="TCC")
- ..F TX=1:1 S TEXT=$T(SUMARY+TX),P3=$P(TEXT,";",3) Q:P3="" I P3[B S SUM=SUM+TOT S SUBTOT=SUBTOT+TOT D
- ...S SETNOD=" "_$J(TOT,6)_" "_$P(TEXT,";",4) D SETNOD Q
- .S SUM2=SUM2+SUM,SETNOD="----------" D SETNOD S SETNOD=$$SPC(" "_$J(SUM,6),12),SETNOD=SETNOD_"Total OPEN consults" D SETNOD S SETNOD=" " D SETNOD
- .S SUM=0,B="" F S B=$O(^TMP($J,"B",A,B)) Q:B="" S TOT=^(B) I TOT'=0 D:B="COMPLETE"!(B="CANCELED")!(B="DSCNTUED")
- ..F TX=1:1 S TEXT=$T(SUMARY+TX),P3=$P(TEXT,";",3) Q:P3="" I P3[B S SUM=SUM+TOT,SETNOD=" "_$J(TOT,6)_" "_$P(TEXT,";",4) D SETNOD Q
- .S SUM2=SUM2+SUM,SETNOD="----------" D SETNOD S SETNOD=$$SPC(" "_$J(SUM,6),12),SETNOD=SETNOD_"Total CLOSED consults" D SETNOD
- .S SETNOD=" " D SETNOD S SETNOD="==========" D SETNOD
- .S SETNOD=$$SPC(" "_$J(SUM2,6),12),SETNOD=SETNOD_"Total "_A_" consults" D SETNOD S SETNOD=" " D SETNOD
- Q
- SUMARY2 ;create the "B" x-reference
- S A="" F S A=$O(^TMP($J,"A",A)) Q:A="" S B=0 F S B=$O(^TMP($J,"A",A,B)) Q:'+B S C=0 F S C=$O(^TMP($J,"A",A,B,C)) Q:'+C S D=0 F S D=$O(^TMP($J,"A",A,B,C,D)) Q:'+D S ND=^(D) D
- .S CLNCNM=$P(^GMR(123.5,B,0),U) S ^TMP($J,"B",CLNCNM,A,C,D)=ND,^TMP($J,"C",A,CLNCNM,C,D)=ND S:'($D(^TMP($J,"B",CLNCNM,A))#2) ^TMP($J,"B",CLNCNM,A)=0 S ^TMP($J,"B",CLNCNM,A)=^TMP($J,"B",CLNCNM,A)+1
- Q
- GMRCONS2 ;ALB/MRY - Consult/Scheduling link report ;4/10/06 14:21
- +1 ;;3.0;CONSULT/REQUEST TRACKING;**52**;DEC 27, 1997
- +2 ;
- +3 ;Continued from GMRCONS1
- +4 DO SUMARY
- DO CT
- DO SUMARY2
- DO CT2
- +5 SET SETNOD=" "
- DO SETNOD
- SET SETNOD=" "
- DO SETNOD
- SET SETNOD="End of report."
- DO SETNOD
- +6 ;
- VALM SET VALMHDR(1)="Service: "_SRVNM
- +1 SET SETNOD=$$SPC("Status",21)
- SET SETNOD=SETNOD_"Date"
- SET SETNOD=$$SPC(SETNOD,31)
- SET SETNOD=SETNOD_"SC"
- SET SETNOD=$$SPC(SETNOD,36)
- SET SETNOD=SETNOD_"L4"
- SET SETNOD=$$SPC(SETNOD,41)
- SET SETNOD=SETNOD_"Patient"
- SET SETNOD=$$SPC(SETNOD,62)
- +2 SET SETNOD=SETNOD_"Appointment"
- SET SETNOD=$$SPC(SETNOD,79)
- SET SETNOD=SETNOD_"Date/Time"
- SET SETNOD=$$SPC(SETNOD,97)
- +3 DO CHGCAP^VALM("CAPTION LINE",SETNOD)
- +4 QUIT
- +5 ;
- SUMARY ;Create the "A" x-ref
- +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 EWL
- +8 ;;ACTWOLHIFC;Active, IFC;Active, Without Link History IFC
- +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 ;;
- +24 FOR A=1:1
- SET B=$TEXT(SUMARY+A)
- IF $PIECE(B,";",3)=""
- QUIT
- SET ^TMP($JOB,"A",$PIECE(B,";",3))=0
- +25 SET ST=""
- FOR
- SET ST=$ORDER(^TMP($JOB,"S",ST))
- IF ST=""
- QUIT
- Begin DoDot:1
- +26 SET AD=0
- FOR
- SET AD=$ORDER(^TMP($JOB,"S",ST,AD))
- IF '+AD
- QUIT
- SET CS=0
- FOR
- SET CS=$ORDER(^TMP($JOB,"S",ST,AD,CS))
- IF '+CS
- QUIT
- SET TND=^(CS)
- SET PTNM=$PIECE(TND,U)
- SET PTIEN=$PIECE(TND,U,2)
- SET LSTACT=$PIECE(TND,U,3)
- SET AWAS1=$PIECE(TND,U,4)
- SET AHST1=$PIECE(TND,U,5)
- SET SRV=$PIECE(TND,U,6)
- Begin DoDot:2
- +27 SET STPCLNC=""
- SET SC=0
- FOR
- SET SC=$ORDER(^GMR(123.5,SRV,688,SC))
- IF '+SC
- QUIT
- SET STPCOD=$PIECE(^GMR(123.5,SRV,688,SC,0),U)
- IF STPCOD'=""
- SET STPCLNC=$PIECE(^DIC(40.7,STPCOD,0),U)_","_STPCLNC
- +28 IF ST="ACTIVE"
- DO ACTIVE
- DO TOC
- +29 IF ST="SCHEDULED"
- DO SCHEDULE
- DO TOC
- +30 IF ST="PENDING"
- DO PENDING
- DO TOC
- +31 IF ST="PARTIAL RESULTS"
- DO INCMPLTE
- DO KILNODE
- DO TOC
- +32 IF ST="CANCELLED"
- DO CANCELED
- DO KILNODE
- DO TCC
- +33 IF ST="DISCONTINUED"
- DO DSCNTUED
- DO KILNODE
- DO TCC
- +34 IF ST="COMPLETE"
- DO COMPLETE
- DO KILNODE
- DO TCC
- End DoDot:2
- KILL WL
- End DoDot:1
- KILL WL
- +35 QUIT
- ACTIVE DO ACTIVE^GMRCONS1
- QUIT
- SCHEDULE DO SCHEDULE^GMRCONS1
- QUIT
- PENDING DO PENDING^GMRCONS1
- QUIT
- INCMPLTE DO INCMPLTE^GMRCONS1
- QUIT
- CANCELED DO CANCELED^GMRCONS1
- QUIT
- DSCNTUED DO DSCNTUED^GMRCONS1
- QUIT
- COMPLETE DO COMPLETE^GMRCONS1
- QUIT
- TOC DO TOC^GMRCONS1
- QUIT
- TCC DO TCC^GMRCONS1
- QUIT
- KILNODE DO KILNODE^GMRCONS1
- QUIT
- +1 ;
- CT ;whole summary
- +1 SET LN=0
- SET WDTH=102
- SET PG=1
- SET $PIECE(DSH,"=",WDTH)=""
- SET FR=$EXTRACT(PSD,4,5)_"/"_$EXTRACT(PSD,6,7)_"/"_$EXTRACT(PSD,2,3)
- SET TO=$EXTRACT(ED,4,5)_"/"_$EXTRACT(ED,6,7)_"/"_$EXTRACT(ED,2,3)
- SET PD=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
- +2 SET SETNOD="SUMMARY From: "_FR_" To "_TO
- SET SETNOD=$$SPC(SETNOD,93)
- SET SETNOD=SETNOD_PD
- DO SETNOD
- +3 SET SETNOD=DSH
- DO SETNOD
- SET SETNOD=" "
- DO SETNOD
- +4 SET PG=PG+1
- SET BB=$ORDER(^TMP($JOB,"A",""))
- SET SUBTOT=0
- +5 SET B=""
- SET SUM2=0
- SET SUM=0
- FOR
- SET B=$ORDER(^TMP($JOB,"A",B))
- IF B=""
- QUIT
- SET TOT=^(B)
- IF TOT'=0
- IF B'="COMPLETE"&(B'="CANCELED")&(B'="DSCNTUED")&(B'="TOC")&(B'="TCC")
- Begin DoDot:1
- +6 FOR TX=1:1
- SET TEXT=$TEXT(SUMARY+TX)
- SET P3=$PIECE(TEXT,";",3)
- IF P3=""
- QUIT
- IF P3[B
- SET SUM=SUM+TOT
- SET SUBTOT=SUBTOT+TOT
- SET SETNOD=" "_$JUSTIFY(TOT,6)_" "_$PIECE(TEXT,";",4)
- DO SETNOD
- QUIT
- End DoDot:1
- +7 SET SUM2=SUM2+SUM
- SET SETNOD="----------"
- DO SETNOD
- SET SETNOD=$$SPC(" "_$JUSTIFY(SUM,6),12)
- SET SETNOD=SETNOD_"Total OPEN consults"
- DO SETNOD
- SET SETNOD=" "
- DO SETNOD
- +8 SET B=""
- SET SUM=0
- FOR
- SET B=$ORDER(^TMP($JOB,"A",B))
- IF B=""
- QUIT
- SET TOT=^(B)
- IF TOT'=0
- IF B="COMPLETE"!(B="CANCELED")!(B="DSCNTUED")
- Begin DoDot:1
- +9 FOR TX=1:1
- SET TEXT=$TEXT(SUMARY+TX)
- SET P3=$PIECE(TEXT,";",3)
- IF P3=""
- QUIT
- IF P3[B
- SET SUM=SUM+TOT
- SET SETNOD=" "_$JUSTIFY(TOT,6)_" "_$PIECE(TEXT,";",4)
- DO SETNOD
- QUIT
- End DoDot:1
- +10 SET SUM2=SUM2+SUM
- SET SETNOD="----------"
- DO SETNOD
- SET SETNOD=$$SPC(" "_$JUSTIFY(SUM,6),12)
- SET SETNOD=SETNOD_"Total CLOSED consults"
- DO SETNOD
- SET SETNOD=" "
- DO SETNOD
- +11 SET SETNOD="=========="
- DO SETNOD
- SET SETNOD=$$SPC(" "_$JUSTIFY(SUM2,6),12)
- SET SETNOD=SETNOD_"GRAND TOTAL"
- DO SETNOD
- SET SETNOD=" "
- DO SETNOD
- +12 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
- SETNOD ;
- +1 SET LN=LN+1
- SET ^TMP("GMRCR",$JOB,"CP",LN,0)=SETNOD
- SET SPC=""
- SET VALMCNT=LN
- +2 QUIT
- CT2 ;print clinic summary
- +1 SET A=""
- FOR
- SET A=$ORDER(^TMP($JOB,"B",A))
- IF A=""
- QUIT
- SET PG=PG+1
- Begin DoDot:1
- +2 SET SETNOD=" "
- DO SETNOD
- +3 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
- +4 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)
- +5 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
- +6 SET PG=PG+1
- SET SUM=0
- SET B=""
- FOR
- SET B=$ORDER(^TMP($JOB,"B",A,B))
- IF B=""
- QUIT
- SET TOT=^(B)
- IF TOT'=0
- IF B'="COMPLETE"&(B'="CANCELED")&(B'="DSCNTUED")&(B'="TOC")&(B'="TCC")
- Begin DoDot:2
- +7 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
- +8 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
- +9 IF P6=1
- IF $DATA(^SC("AWAS1",CNSLT))
- Begin DoDot:5
- +10 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)
- +11 SET Y=SDAPT
- DO DD^%DT
- SET SDAPTIM=$EXTRACT($PIECE(Y,"@",2),1,5)
- End DoDot:5
- +12 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)
- +13 IF P6=1
- Begin DoDot:5
- +14 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
- SET SUM=SUM+TOT
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +15 SET SETNOD=" "
- DO SETNOD
- +16 SET BB=$ORDER(^TMP($JOB,"B",A,""))
- SET SUBTOT=0
- SET SUM2=0
- SET SUM=0
- SET B=""
- FOR
- SET B=$ORDER(^TMP($JOB,"B",A,B))
- IF B=""
- QUIT
- SET TOT=^(B)
- IF TOT'=0
- IF B'="COMPLETE"&(B'="CANCELED")&(B'="DSCNTUED")&(B'="TOC")&(B'="TCC")
- Begin DoDot:2
- +17 FOR TX=1:1
- SET TEXT=$TEXT(SUMARY+TX)
- SET P3=$PIECE(TEXT,";",3)
- IF P3=""
- QUIT
- IF P3[B
- SET SUM=SUM+TOT
- SET SUBTOT=SUBTOT+TOT
- Begin DoDot:3
- +18 SET SETNOD=" "_$JUSTIFY(TOT,6)_" "_$PIECE(TEXT,";",4)
- DO SETNOD
- QUIT
- End DoDot:3
- End DoDot:2
- +19 SET SUM2=SUM2+SUM
- SET SETNOD="----------"
- DO SETNOD
- SET SETNOD=$$SPC(" "_$JUSTIFY(SUM,6),12)
- SET SETNOD=SETNOD_"Total OPEN consults"
- DO SETNOD
- SET SETNOD=" "
- DO SETNOD
- +20 SET SUM=0
- SET B=""
- FOR
- SET B=$ORDER(^TMP($JOB,"B",A,B))
- IF B=""
- QUIT
- SET TOT=^(B)
- IF TOT'=0
- IF B="COMPLETE"!(B="CANCELED")!(B="DSCNTUED")
- Begin DoDot:2
- +21 FOR TX=1:1
- SET TEXT=$TEXT(SUMARY+TX)
- SET P3=$PIECE(TEXT,";",3)
- IF P3=""
- QUIT
- IF P3[B
- SET SUM=SUM+TOT
- SET SETNOD=" "_$JUSTIFY(TOT,6)_" "_$PIECE(TEXT,";",4)
- DO SETNOD
- QUIT
- End DoDot:2
- +22 SET SUM2=SUM2+SUM
- SET SETNOD="----------"
- DO SETNOD
- SET SETNOD=$$SPC(" "_$JUSTIFY(SUM,6),12)
- SET SETNOD=SETNOD_"Total CLOSED consults"
- DO SETNOD
- +23 SET SETNOD=" "
- DO SETNOD
- SET SETNOD="=========="
- DO SETNOD
- +24 SET SETNOD=$$SPC(" "_$JUSTIFY(SUM2,6),12)
- SET SETNOD=SETNOD_"Total "_A_" consults"
- DO SETNOD
- SET SETNOD=" "
- DO SETNOD
- End DoDot:1
- +25 QUIT
- SUMARY2 ;create the "B" x-reference
- +1 SET A=""
- FOR
- SET A=$ORDER(^TMP($JOB,"A",A))
- IF A=""
- QUIT
- SET B=0
- FOR
- SET B=$ORDER(^TMP($JOB,"A",A,B))
- IF '+B
- QUIT
- SET C=0
- FOR
- SET C=$ORDER(^TMP($JOB,"A",A,B,C))
- IF '+C
- QUIT
- SET D=0
- FOR
- SET D=$ORDER(^TMP($JOB,"A",A,B,C,D))
- IF '+D
- QUIT
- SET ND=^(D)
- Begin DoDot:1
- +2 SET CLNCNM=$PIECE(^GMR(123.5,B,0),U)
- SET ^TMP($JOB,"B",CLNCNM,A,C,D)=ND
- SET ^TMP($JOB,"C",A,CLNCNM,C,D)=ND
- IF '($DATA(^TMP($JOB,"B",CLNCNM,A))#2)
- SET ^TMP($JOB,"B",CLNCNM,A)=0
- SET ^TMP($JOB,"B",CLNCNM,A)=^TMP($JOB,"B",CLNCNM,A)+1
- End DoDot:1
- +3 QUIT
