- 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 Feb 18, 2025@23:25:18 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
