ECSUM1 ;BIR/JLP,RHK-Category and Procedure Summary (cont'd) ;Oct 14, 2020@14:27:23
;;2.0;EVENT CAPTURE;**4,19,23,33,47,95,100,119,122,126,131,139,152**;8 May 96;Build 19
ALLU ;
N UCNT,ECDO,ECCO,ECNT,ECD,ECMORE,ECEDN,ECEDNST,ECCPT,ECDNPCE,ECDNDEPT ;119,122,126
S (ECD,ECMORE,ECNT,ECDO,ECCO)=0,ECPG=$G(ECPG,1),ECSCN=$G(ECSCN,"B")
F S ECD=$O(^ECJ("AP",ECL,ECD)) Q:'ECD D Q:ECOUT
.Q:'$D(ECUNITS(ECD)) ;139 Stop if DSS unit isn't in list
.D SET,CATS I $G(ECPTYP)'="E" D PAGE:'ECOUT&UCNT ;119
END Q:$G(ECPTYP)="E" I 'ECNT N ECNOCNT S ECNOCNT=1 D HEADER W !!!,"Nothing Found." ;119
S ECPG=$G(ECPG,1)
Q
SUM2 ;Prints Categories and Procedures for a DSS Unit
N UCNT,ECDO,ECCO,ECNT,ECMORE,ECEDN,ECEDNST,ECCPT,ECDNPCE,ECDNDEPT ;119,122,126
S (ECDO,ECMORE,UCNT,ECNT,ECCO)=0,ECPG=$G(ECPG,1),ECSCN=$G(ECSCN,"B")
D SET ;126
I ECC="ALL" D CATS G END
I 'ECJLP S ECC=0,ECCN="None",ECCO=999
D PROC
D END
Q
SET ;set var
S (ECDN,ECEDN)=$S($P($G(^ECD(+ECD,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN"),UCNT=0 ;119
S ECDN=ECDN_" ("_+ECD_")"_$S($P($G(^ECD(+ECD,0)),"^",6):" **Inactive**",1:"") ;131
S ECEDNST=$S($P($G(^ECD(+ECD,0)),U,6):"INACTIVE",1:"") ;119
S ECDNPCE=$$GET1^DIQ(724,+ECD,13,"E") ;126 send to pce
S ECDNDEPT=$$GET1^DIQ(724,+ECD,4,"E") ;126 DSS Dept
S ECS=+$P($G(^ECD(+ECD,0)),"^",2)
S ECSN=$S($P($G(^DIC(49,ECS,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
Q
SETC ;set cats
I ECC=0 S ECCN="None" Q
S ECCN=$S($P($G(^EC(726,+ECC,0)),"^")]"":$P(^(0),"^"),1:"ZZ #"_ECC_" MISSING DATA")
S ECCN=ECCN_$S($P($G(^EC(726,+ECC,0)),"^",3):" **Inactive**",1:"")
S ECMORE=1
Q
W:$E(IOST,1,2)="C-"!(ECPG>1) @IOF
W !!,?25,$S($G(ECDIS):"DISABLED ",1:""),"CATEGORY AND PROCEDURE SUMMARY",?122,"Page: ",ECPG,! ;131 added conditional print of disabled;152 changed to 132 characters
W ?27,$S(ECSCN="I":"INACTIVE",ECSCN="A":"ACTIVE",1:" ALL")_" EVENT CODE"
W " SCREENS",!?25,"Run Date: ",ECRDT,!?25,"LOCATION: "_ECLN ;126
I $G(ECNOCNT) W ! S ECPG=ECPG+1
I '$G(ECNOCNT) D ;126
.W !,?25,"SERVICE: ",ECSN,!?25,"DSS UNIT: "_ECDN,!,?25,"SEND STATUS: ",ECDNPCE,!,?25,"DSS DEPT: ",ECDNDEPT ;126
.;W !!,"PROC",?7,"PROCEDURE NAME",!,"CODE",?7,"SYNONYM",!,?9,"CLINIC IEN/CLINIC/STOP CODE/CREDIT STOP/CHAR4/MCA LABOR CODE",! S ECPG=ECPG+1 ;126,139
.W !!,"PROC",?7,"PROCEDURE NAME/SYNONYM",?74,"CLINIC IEN/CLINIC/STOP CODE/CREDIT STOP/",!,?74,"CHAR4/MCA LABOR CODE",! S ECPG=ECPG+1 ;126;139;152
F I=1:1:132 W "-" ;152 Report Layout changed to 132 characters
Q
CATS ;
S ECC="",ECCO=0
F S ECC=$O(^ECJ("AP",ECL,ECD,ECC)) Q:ECC="" D Q:ECOUT ;131 Moved calls to dot structure
.I '$G(ECDIS),ECC,'$P(^ECD(ECD,0),U,11) Q ;131 If running the category and procedure summary report, and there's a category, and the DSS unit is set to "no categories" then quit
.D SETC,PROC ;131 Moved calls here from for loop
S ECMORE=0
Q
PROC ;
S ECP=""
F S ECP=$O(^ECJ("AP",ECL,ECD,ECC,ECP)) Q:ECP="" D SETP Q:ECOUT
S ECMORE=0
Q
SETP ;set procs
N ECSC,ECSSC,EC4CHAR,NODE0,ECINDT,ECMCA ;122,126,139
S ECPSY=+$O(^ECJ("AP",ECL,ECD,ECC,ECP,""))
S ECINDT=$P($G(^ECJ(ECPSY,0)),"^",2)
I ECSCN="A",ECINDT'="" Q
I ECSCN="I",ECINDT="" Q
I ECD'=ECDO D:$G(ECPTYP)'="E" HEADER S ECDO=ECD ;119
I ECC'=ECCO D S ECCO=ECC I ECOUT Q
.I $G(ECPTYP)="E" Q ;119
.W !!,$S($G(ECDIS):"Disabled ",1:""),"Category: "_ECCN D:$Y+4>IOSL PAGE,HEADER:ECPG,MORE:$D(ECCN) ;122,131 Removed white space from front of line
S ECPSYN=$P($G(^ECJ(ECPSY,"PRO")),"^",2),EC4=+$P($G(^("PRO")),"^",4)
S EC2="" I EC4 S EC2=$S($P($G(^SC(EC4,0)),"^")]"":$P(^(0),"^"),1:"NO ASSOCIATED CLINIC")
S (ECSC,ECSSC,EC4CHAR,ECMCA)="" ;122,139
I EC4 D ;139
.S NODE0=$G(^ECX(728.44,EC4,0)),ECSC=$P(NODE0,U,2),ECSSC=$S($P(NODE0,U,3)'="":$P(NODE0,U,3),$G(ECPTYP)="E":"",1:"000"),EC4CHAR=$P($G(^ECX(728.441,+$P(NODE0,U,8),0)),U) ;122,139 Get stop code, credit stop code, char4 code
.S ECMCA=$$GET1^DIQ(728.442,$P(NODE0,U,14),.01) ;139 Get MCA labor code
S ECFILE=$P(ECP,";",2),ECFILE=$S($E(ECFILE)="I":81,$E(ECFILE)="E":725,1:"UNKNOWN")
I ECFILE="UNKNOWN" S ECPN="UNKNOWN",NATN="UNKNOWN"
I ECFILE=81 S ECPI=$$CPT^ICPTCOD(+ECP) D
.S ECPN=$S($P(ECPI,"^",3)]"":$P(ECPI,"^",3),1:"UNKNOWN"),NATN=$S($P(ECPI,"^",2)]"":$P(ECPI,"^",2),1:"NOT LISTED") K ECPI
I ECFILE=725 S ECPN=$S($P($G(^EC(725,+ECP,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN"),NATN=$S($P($G(^EC(725,+ECP,0)),"^",2)]"":$P(^(0),"^",2),1:"NOT LISTED")
I ECFILE=725 S ECCPT=$$CPT^ICPTCOD(+$P($G(^EC(725,+ECP,0)),U,5)),ECCPT=$S($P(ECCPT,U)=-1:"",1:$P(ECCPT,U,2)) ;119
S ECNT=ECNT+1,UCNT=UCNT+1 ;126
I $G(ECPTYP)="E" D Q ;119
.D SET ; SET THE DSS UNIT AND UNIT STATUS VARIABLES 119
.S CNT=CNT+1 ;119
.S ^TMP($J,"ECRPT",CNT)=$S($P($G(^ECJ(+ECPSY,0)),U,2):"INACTIVE",1:"ACTIVE")_U_ECLN_U_ECSN_U_ECEDN_U_+ECD_U_ECDNDEPT ;119,122,126,131
.S ^TMP($J,"ECRPT",CNT)=^TMP($J,"ECRPT",CNT)_U_ECDNPCE_U_ECEDNST_U_ECCN_U_$S(ECFILE=81:NATN_U,1:ECCPT_U_NATN)_U_ECPN_U_ECPSYN_U_$S(EC4:EC4,1:"")_U_EC2_U_ECSC_U_ECSSC_U_EC4CHAR_U_ECMCA ;119,122,126,139
W !,NATN,?7,ECPN," (",$S(ECFILE=81:"CPT",1:"EC"),")" ;122,126,139
;***152 Begins
;I $P($G(^ECJ(+ECPSY,0)),"^",2),ECSCN="B" W ?70,"*INACTIVE*"
;W:ECPSYN'="" !,?7,ECPSYN ;139 Moved line here from above
;W:EC2]"" !,?9,EC4_"/"_EC2_"/"_ECSC_"/"_ECSSC_"/"_EC4CHAR_"/"_ECMCA ;122,126,139
W:ECPSYN'="" "/",ECPSYN ;152 Moved Synonym to same line with Procedure Name
W:EC2]"" ?74,EC4_"/"_EC2_"/"_ECSC_"/"_ECSSC_"/"_EC4CHAR_"/"_ECMCA ;122,126,139,152 - Report Layout changed to 132 chars.
I $P($G(^ECJ(+ECPSY,0)),"^",2),ECSCN="B" W ?122,"*INACTIVE*"
;*** 152 Ends
D:($Y+3)>IOSL PAGE,HEADER:ECPG,MORE:$D(ECCN) Q:ECOUT
Q
PAGE ;
N SS,JJ
I $D(ECPG),$E(IOST,1,2)="C-" D
. S SS=22-$Y F JJ=1:1:SS W !
. S DIR(0)="E" W ! D ^DIR K DIR I 'Y S ECOUT=1
Q
MORE I ECMORE W !!,$S($G(ECDIS):"Disabled ",1:""),"Category: "_ECCN ;122,131 Removed white space from front of line
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECSUM1 5931 printed Dec 13, 2024@01:58:54 Page 2
ECSUM1 ;BIR/JLP,RHK-Category and Procedure Summary (cont'd) ;Oct 14, 2020@14:27:23
+1 ;;2.0;EVENT CAPTURE;**4,19,23,33,47,95,100,119,122,126,131,139,152**;8 May 96;Build 19
ALLU ;
+1 ;119,122,126
NEW UCNT,ECDO,ECCO,ECNT,ECD,ECMORE,ECEDN,ECEDNST,ECCPT,ECDNPCE,ECDNDEPT
+2 SET (ECD,ECMORE,ECNT,ECDO,ECCO)=0
SET ECPG=$GET(ECPG,1)
SET ECSCN=$GET(ECSCN,"B")
+3 FOR
SET ECD=$ORDER(^ECJ("AP",ECL,ECD))
if 'ECD
QUIT
Begin DoDot:1
+4 ;139 Stop if DSS unit isn't in list
if '$DATA(ECUNITS(ECD))
QUIT
+5 ;119
DO SET
DO CATS
IF $GET(ECPTYP)'="E"
if 'ECOUT&UCNT
DO PAGE
End DoDot:1
if ECOUT
QUIT
END ;119
if $GET(ECPTYP)="E"
QUIT
IF 'ECNT
NEW ECNOCNT
SET ECNOCNT=1
DO HEADER
WRITE !!!,"Nothing Found."
+1 SET ECPG=$GET(ECPG,1)
+2 QUIT
SUM2 ;Prints Categories and Procedures for a DSS Unit
+1 ;119,122,126
NEW UCNT,ECDO,ECCO,ECNT,ECMORE,ECEDN,ECEDNST,ECCPT,ECDNPCE,ECDNDEPT
+2 SET (ECDO,ECMORE,UCNT,ECNT,ECCO)=0
SET ECPG=$GET(ECPG,1)
SET ECSCN=$GET(ECSCN,"B")
+3 ;126
DO SET
+4 IF ECC="ALL"
DO CATS
GOTO END
+5 IF 'ECJLP
SET ECC=0
SET ECCN="None"
SET ECCO=999
+6 DO PROC
+7 DO END
+8 QUIT
SET ;set var
+1 ;119
SET (ECDN,ECEDN)=$SELECT($PIECE($GET(^ECD(+ECD,0)),"^")]"":$PIECE(^(0),"^"),1:"UNKNOWN")
SET UCNT=0
+2 ;131
SET ECDN=ECDN_" ("_+ECD_")"_$SELECT($PIECE($GET(^ECD(+ECD,0)),"^",6):" **Inactive**",1:"")
+3 ;119
SET ECEDNST=$SELECT($PIECE($GET(^ECD(+ECD,0)),U,6):"INACTIVE",1:"")
+4 ;126 send to pce
SET ECDNPCE=$$GET1^DIQ(724,+ECD,13,"E")
+5 ;126 DSS Dept
SET ECDNDEPT=$$GET1^DIQ(724,+ECD,4,"E")
+6 SET ECS=+$PIECE($GET(^ECD(+ECD,0)),"^",2)
+7 SET ECSN=$SELECT($PIECE($GET(^DIC(49,ECS,0)),"^")]"":$PIECE(^(0),"^"),1:"UNKNOWN")
+8 QUIT
SETC ;set cats
+1 IF ECC=0
SET ECCN="None"
QUIT
+2 SET ECCN=$SELECT($PIECE($GET(^EC(726,+ECC,0)),"^")]"":$PIECE(^(0),"^"),1:"ZZ #"_ECC_" MISSING DATA")
+3 SET ECCN=ECCN_$SELECT($PIECE($GET(^EC(726,+ECC,0)),"^",3):" **Inactive**",1:"")
+4 SET ECMORE=1
+5 QUIT
+1 if $EXTRACT(IOST,1,2)="C-"!(ECPG>1)
WRITE @IOF
+2 ;131 added conditional print of disabled;152 changed to 132 characters
WRITE !!,?25,$SELECT($GET(ECDIS):"DISABLED ",1:""),"CATEGORY AND PROCEDURE SUMMARY",?122,"Page: ",ECPG,!
+3 WRITE ?27,$SELECT(ECSCN="I":"INACTIVE",ECSCN="A":"ACTIVE",1:" ALL")_" EVENT CODE"
+4 ;126
WRITE " SCREENS",!?25,"Run Date: ",ECRDT,!?25,"LOCATION: "_ECLN
+5 IF $GET(ECNOCNT)
WRITE !
SET ECPG=ECPG+1
+6 ;126
IF '$GET(ECNOCNT)
Begin DoDot:1
+7 ;126
WRITE !,?25,"SERVICE: ",ECSN,!?25,"DSS UNIT: "_ECDN,!,?25,"SEND STATUS: ",ECDNPCE,!,?25,"DSS DEPT: ",ECDNDEPT
+8 ;W !!,"PROC",?7,"PROCEDURE NAME",!,"CODE",?7,"SYNONYM",!,?9,"CLINIC IEN/CLINIC/STOP CODE/CREDIT STOP/CHAR4/MCA LABOR CODE",! S ECPG=ECPG+1 ;126,139
+9 ;126;139;152
WRITE !!,"PROC",?7,"PROCEDURE NAME/SYNONYM",?74,"CLINIC IEN/CLINIC/STOP CODE/CREDIT STOP/",!,?74,"CHAR4/MCA LABOR CODE",!
SET ECPG=ECPG+1
End DoDot:1
+10 ;152 Report Layout changed to 132 characters
FOR I=1:1:132
WRITE "-"
+11 QUIT
CATS ;
+1 SET ECC=""
SET ECCO=0
+2 ;131 Moved calls to dot structure
FOR
SET ECC=$ORDER(^ECJ("AP",ECL,ECD,ECC))
if ECC=""
QUIT
Begin DoDot:1
+3 ;131 If running the category and procedure summary report, and there's a category, and the DSS unit is set to "no categories" then quit
IF '$GET(ECDIS)
IF ECC
IF '$PIECE(^ECD(ECD,0),U,11)
QUIT
+4 ;131 Moved calls here from for loop
DO SETC
DO PROC
End DoDot:1
if ECOUT
QUIT
+5 SET ECMORE=0
+6 QUIT
PROC ;
+1 SET ECP=""
+2 FOR
SET ECP=$ORDER(^ECJ("AP",ECL,ECD,ECC,ECP))
if ECP=""
QUIT
DO SETP
if ECOUT
QUIT
+3 SET ECMORE=0
+4 QUIT
SETP ;set procs
+1 ;122,126,139
NEW ECSC,ECSSC,EC4CHAR,NODE0,ECINDT,ECMCA
+2 SET ECPSY=+$ORDER(^ECJ("AP",ECL,ECD,ECC,ECP,""))
+3 SET ECINDT=$PIECE($GET(^ECJ(ECPSY,0)),"^",2)
+4 IF ECSCN="A"
IF ECINDT'=""
QUIT
+5 IF ECSCN="I"
IF ECINDT=""
QUIT
+6 ;119
IF ECD'=ECDO
if $GET(ECPTYP)'="E"
DO HEADER
SET ECDO=ECD
+7 IF ECC'=ECCO
Begin DoDot:1
+8 ;119
IF $GET(ECPTYP)="E"
QUIT
+9 ;122,131 Removed white space from front of line
WRITE !!,$SELECT($GET(ECDIS):"Disabled ",1:""),"Category: "_ECCN
if $Y+4>IOSL
DO PAGE
if ECPG
DO HEADER
if $DATA(ECCN)
DO MORE
End DoDot:1
SET ECCO=ECC
IF ECOUT
QUIT
+10 SET ECPSYN=$PIECE($GET(^ECJ(ECPSY,"PRO")),"^",2)
SET EC4=+$PIECE($GET(^("PRO")),"^",4)
+11 SET EC2=""
IF EC4
SET EC2=$SELECT($PIECE($GET(^SC(EC4,0)),"^")]"":$PIECE(^(0),"^"),1:"NO ASSOCIATED CLINIC")
+12 ;122,139
SET (ECSC,ECSSC,EC4CHAR,ECMCA)=""
+13 ;139
IF EC4
Begin DoDot:1
+14 ;122,139 Get stop code, credit stop code, char4 code
SET NODE0=$GET(^ECX(728.44,EC4,0))
SET ECSC=$PIECE(NODE0,U,2)
SET ECSSC=$SELECT($PIECE(NODE0,U,3)'="":$PIECE(NODE0,U,3),$GET(ECPTYP)="E":"",1:"000")
SET EC4CHAR=$PIECE($GET(^ECX(728.441,+$PIECE(NODE0,U,8),0)),U)
+15 ;139 Get MCA labor code
SET ECMCA=$$GET1^DIQ(728.442,$PIECE(NODE0,U,14),.01)
End DoDot:1
+16 SET ECFILE=$PIECE(ECP,";",2)
SET ECFILE=$SELECT($EXTRACT(ECFILE)="I":81,$EXTRACT(ECFILE)="E":725,1:"UNKNOWN")
+17 IF ECFILE="UNKNOWN"
SET ECPN="UNKNOWN"
SET NATN="UNKNOWN"
+18 IF ECFILE=81
SET ECPI=$$CPT^ICPTCOD(+ECP)
Begin DoDot:1
+19 SET ECPN=$SELECT($PIECE(ECPI,"^",3)]"":$PIECE(ECPI,"^",3),1:"UNKNOWN")
SET NATN=$SELECT($PIECE(ECPI,"^",2)]"":$PIECE(ECPI,"^",2),1:"NOT LISTED")
KILL ECPI
End DoDot:1
+20 IF ECFILE=725
SET ECPN=$SELECT($PIECE($GET(^EC(725,+ECP,0)),"^")]"":$PIECE(^(0),"^"),1:"UNKNOWN")
SET NATN=$SELECT($PIECE($GET(^EC(725,+ECP,0)),"^",2)]"":$PIECE(^(0),"^",2),1:"NOT LISTED")
+21 ;119
IF ECFILE=725
SET ECCPT=$$CPT^ICPTCOD(+$PIECE($GET(^EC(725,+ECP,0)),U,5))
SET ECCPT=$SELECT($PIECE(ECCPT,U)=-1:"",1:$PIECE(ECCPT,U,2))
+22 ;126
SET ECNT=ECNT+1
SET UCNT=UCNT+1
+23 ;119
IF $GET(ECPTYP)="E"
Begin DoDot:1
+24 ; SET THE DSS UNIT AND UNIT STATUS VARIABLES 119
DO SET
+25 ;119
SET CNT=CNT+1
+26 ;119,122,126,131
SET ^TMP($JOB,"ECRPT",CNT)=$SELECT($PIECE($GET(^ECJ(+ECPSY,0)),U,2):"INACTIVE",1:"ACTIVE")_U_ECLN_U_ECSN_U_ECEDN_U_+ECD_U_ECDNDEPT
+27 ;119,122,126,139
SET ^TMP($JOB,"ECRPT",CNT)=^TMP($JOB,"ECRPT",CNT)_U_ECDNPCE_U_ECEDNST_U_ECCN_U_$SELECT(ECFILE=81:NATN_U,1:ECCPT_U_NATN)_U_ECPN_U_ECPSYN_U_$SELECT(EC4:EC4,1:"")_U_EC2_U_ECSC_U_ECSSC_U_EC4CHAR_U_ECMCA
End DoDot:1
QUIT
+28 ;122,126,139
WRITE !,NATN,?7,ECPN," (",$SELECT(ECFILE=81:"CPT",1:"EC"),")"
+29 ;***152 Begins
+30 ;I $P($G(^ECJ(+ECPSY,0)),"^",2),ECSCN="B" W ?70,"*INACTIVE*"
+31 ;W:ECPSYN'="" !,?7,ECPSYN ;139 Moved line here from above
+32 ;W:EC2]"" !,?9,EC4_"/"_EC2_"/"_ECSC_"/"_ECSSC_"/"_EC4CHAR_"/"_ECMCA ;122,126,139
+33 ;152 Moved Synonym to same line with Procedure Name
if ECPSYN'=""
WRITE "/",ECPSYN
+34 ;122,126,139,152 - Report Layout changed to 132 chars.
if EC2]""
WRITE ?74,EC4_"/"_EC2_"/"_ECSC_"/"_ECSSC_"/"_EC4CHAR_"/"_ECMCA
+35 IF $PIECE($GET(^ECJ(+ECPSY,0)),"^",2)
IF ECSCN="B"
WRITE ?122,"*INACTIVE*"
+36 ;*** 152 Ends
+37 if ($Y+3)>IOSL
DO PAGE
if ECPG
DO HEADER
if $DATA(ECCN)
DO MORE
if ECOUT
QUIT
+38 QUIT
PAGE ;
+1 NEW SS,JJ
+2 IF $DATA(ECPG)
IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+3 SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
+4 SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
IF 'Y
SET ECOUT=1
End DoDot:1
+5 QUIT
MORE ;122,131 Removed white space from front of line
IF ECMORE
WRITE !!,$SELECT($GET(ECDIS):"Disabled ",1:""),"Category: "_ECCN
+1 QUIT
