- ECSCRN ;BIR/MAM,JPW,RKH,TTH-Enter Event Code Screens ;1 May 96
- ;;2.0; EVENT CAPTURE ;**4,5,33,47**;8 May 96
- I $O(^DIC(4,"LOC",""))="" W !!,"You have no locations flagged for event capture.",!,"See your program coordinator.",!! W "Press <RET> to continue " R X:DTIME K X Q
- W @IOF,!,"Event Code Screens (Create)",! F XX=0:1:79 W "-"
- S (MSG1,MSG2)=0
- UNIT W ! K DIC S ECNOPE="",DIC=724,DIC(0)="QEAMZ",DIC("A")="Select DSS Unit : ",DIC("S")="I $P($G(^(0)),""^"",8)=1,'$P(^(0),""^"",6)" D ^DIC G:Y<0 END S ECD=+Y,ECDN=$P(Y,"^",2)
- S ECS=$P(^ECD(ECD,0),"^",2),ECM=$P(^(0),"^",3),ECPCE="U~"_$S($P($G(^(0)),"^",14)]"":$P(^(0),"^",14),1:"N"),ECSN=$P(^DIC(49,ECS,0),"^"),ECMN=$P(^ECC(723,ECM,0),"^")
- K ECN,ECL
- D BRO I $D(ECERR) G END
- G PRO
- PRO W:$D(ECN) !,"DSS UNIT: "_ECDN,! K DIC,DIR,DUOUT S DIR(0)="720.3,52.1",DIR("A")="Select Procedure" D ^DIR K DIR G:$D(DUOUT)!($D(DTOUT)) END
- I X=""!("@"[X) G END
- S ECFIL="^"_$P(Y,";",2)
- S ECZERO=@(ECFIL_+Y_",0)"),DSERR=0
- I $E(ECFIL,2)="E" D I DSERR S DSERR=0 G PRO
- .I $P($G(ECZERO),U,3) W !,"Selected procedure is inactive at this time.",! S DSERR=1 Q
- I $E(ECFIL,2)="I" D I DSERR S DSERR=0 G PRO
- .I '$P($$CPT^ICPTCOD(+Y),"^",7) W !,"Selected procedure is inactive at this time.",! S DSERR=1
- S ECP=Y,ECPN=$P(Y,"^",2)
- W @IOF S ECANS=0 D ASK2^ECSCR G:$D(DIRUT) END I '$G(ECANS) D END1 W ! G UNIT
- D:'$D(ECL) ^ECSCR G:'$D(ECL) END
- D ASK I $D(DIRUT)!(Y=0) D END2 G RESEL
- I $G(ECLOC)=1 S ECLALL=0 F I=0:0 S ECLALL=$O(LOC1(ECLALL)) Q:'ECLALL S ECL=$P(LOC1(ECLALL),"^",2),ECLN=$P(LOC1(ECLALL),"^") D STUFF I ECOUT G END
- I $G(ECLOC)=0 S ECLALL=0 F I=0:0 S ECLALL=$O(LOC(ECLALL)) Q:'ECLALL S ECL=$P(LOC(ECLALL),"^",2),ECLN=$P(LOC(ECLALL),"^") D STUFF I ECOUT G END
- RESEL D MORE G:X="^" END D END2 G PRO
- STUFF ; stuff entries
- S ECCH=ECL_"-"_ECD_"-"_ECC_"-"_ECP
- I $D(^ECJ("B",ECCH)) D INACT Q
- S X=ECCH,DIC="^ECJ(",DIC(0)="L",DLAYGO=720.3 K DD,DO D FILE^DICN K DIC
- S ECFN=+Y
- W !!,"Entering screen for "_ECLN_" with procedure ",$$NAM^ECSCR,"..."
- S $P(^ECJ(ECFN,0),"^",3)=DT
- S $P(^ECJ(ECFN,"PRO"),U)=ECP
- S DA=ECFN,DIK="^ECJ(" D IX^DIK
- S ^ECJ("AP",ECL,ECD,ECC,ECP,ECFN)=""
- S ^ECJ("APP",ECL,ECD,ECP,ECFN)=""
- ;
- ;ALB/ESD - Ask procedure reason indicator
- S DA=ECFN,DIE=720.3
- S DR=$S($P(ECPCE,"~",2)="N":"",1:"55T//^S X=$G(DEFASCLN);")_"53T;54T;56T"
- D ^DIE K DIE,DA,DR I $D(Y) S ECOUT=1
- I $P(ECPCE,"~",2)'="N" D
- . S DIC="^SC(",DIC(0)="N",X=$P($G(^ECJ(ECFN,"PRO")),U,4)
- . D ^DIC S DEFASCLN=$P(Y,U,2) K DIC
- ;
- ;ALB/ESD - If proc reasons indictor is YES, ask procedure reasons
- I $P($G(^ECJ(ECFN,"PRO")),"^",5)=1 D ADREAS^ECDSUTIL(ECFN)
- ;
- ;ALB/ESD - Always ask associated clinic and do active clinic check
- ;ALB/JAM - Only ask for associated clinic if DSS Unit sends data to PCE
- I $P(ECPCE,"~",2)'="N" D CLIN
- Q
- MORE W !!,"Press <RET> to continue " R X:DTIME S:'$T X="^" Q:X="^"
- K ECP,Y,ECCH
- W @IOF,!,"Event Code Screen Information:"
- W !,"----------------------------",!
- W !,"DSS Unit: "_ECDN,!,"Category: "_ECCN,!!
- Q
- ;
- END ;Kill variables.
- W @IOF
- END1 K ECNOPE,ECZERO,DEFASCLN D ^ECKILL
- END2 K C,CNT,DIR,DSERR,ECANS,ECFIL,ECL,ECLASS,ECLN,ECP,ECPN,ECS,ECWORK,ECS
- K ECZERO,LOC1,NUM,X,Y
- Q
- BRO ; check for category use in data entry
- I '$P(^ECD(ECD,0),U,11) S ECC=0,ECCN="None" W !,"Category: "_ECCN,!! Q
- I $P(^ECD(ECD,0),U,11) D
- .S DIC=726,DIC(0)="AEQMZ",DIC("A")="Select Category : ",DIC("S")="I '$P(^(0),U,3)!(+$P(^(0),U,3)>DT)"
- .D ^DIC K DIC I Y<0 S ECERR=1 Q
- .S ECC=+Y,ECCN=Y(0,0)
- Q
- INACT ; check to determine if inactive
- S ECX=$O(^ECJ("B",ECCH,0)) I '$P(^ECJ(ECX,0),"^",2) W !!,"This screen has already been created for "_ECLN_"." Q
- S Y=$$FMTE^XLFDT($P(^ECJ(ECX,0),"^",2))
- W !!,"This event code for "_ECLN_" inactivated on "_Y_".",!,"Do you want to reactivate it ? NO// " R ECYN:DTIME I '$T!(ECYN="^") Q
- S ECYN=$E(ECYN) S:ECYN="" ECYN="N" I "YyNn"'[ECYN W !!,"Enter YES if this code should be reactivated for event code",!,"procedures, or <RET> to continue with another procedure." G INACT
- Q:"Nn"[ECYN W !!,"Reactivating Event Code Screen... " K DR,DIE S DA=ECX,DIE="^ECJ(",DR="1///@" D ^DIE S ^ECJ("AP",ECL,ECD,ECC,ECP,DA)="",^ECJ("APP",ECL,ECD,ECP,DA)="" K DR,DIE,DA
- Q
- ASK ;Ask user to verify update.
- W ! S DIR(0)="Y",DIR("B")="YES",DIR("A")="Are you sure that you want to create the screen"
- D ^DIR Q:$D(DIRUT) S ECANS=+Y
- Q
- CLIN ;check for active associated clinic
- S MSG1=1,MSG2=0
- S EC4=$P($G(^ECJ(+ECFN,"PRO")),"^",4) I EC4']"" S MSG2=1
- D CLIN^ECPCEU
- I 'ECPCL D
- .W !!,"The clinic ",$S(MSG1:"associated with",1:"you selected for")," this event code screen ",$S(MSG2:"has not been entered",1:"is inactive"),"."
- .W !,"Workload data cannot be sent to PCE for this event code screen with ",!,$S(MSG2:"a missing",1:"an inactive")," clinic."
- .W !!,"Please use the Procedure Synonym/Default Volume (Enter/Edit) option to enter",!,"an active clinic.",!!
- S (MSG1,MSG2)=0
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECSCRN 4955 printed Jan 18, 2025@03:00:04 Page 2
- ECSCRN ;BIR/MAM,JPW,RKH,TTH-Enter Event Code Screens ;1 May 96
- +1 ;;2.0; EVENT CAPTURE ;**4,5,33,47**;8 May 96
- +2 IF $ORDER(^DIC(4,"LOC",""))=""
- WRITE !!,"You have no locations flagged for event capture.",!,"See your program coordinator.",!!
- WRITE "Press <RET> to continue "
- READ X:DTIME
- KILL X
- QUIT
- +3 WRITE @IOF,!,"Event Code Screens (Create)",!
- FOR XX=0:1:79
- WRITE "-"
- +4 SET (MSG1,MSG2)=0
- UNIT WRITE !
- KILL DIC
- SET ECNOPE=""
- SET DIC=724
- SET DIC(0)="QEAMZ"
- SET DIC("A")="Select DSS Unit : "
- SET DIC("S")="I $P($G(^(0)),""^"",8)=1,'$P(^(0),""^"",6)"
- DO ^DIC
- if Y<0
- GOTO END
- SET ECD=+Y
- SET ECDN=$PIECE(Y,"^",2)
- +1 SET ECS=$PIECE(^ECD(ECD,0),"^",2)
- SET ECM=$PIECE(^(0),"^",3)
- SET ECPCE="U~"_$SELECT($PIECE($GET(^(0)),"^",14)]"":$PIECE(^(0),"^",14),1:"N")
- SET ECSN=$PIECE(^DIC(49,ECS,0),"^")
- SET ECMN=$PIECE(^ECC(723,ECM,0),"^")
- +2 KILL ECN,ECL
- +3 DO BRO
- IF $DATA(ECERR)
- GOTO END
- +4 GOTO PRO
- PRO if $DATA(ECN)
- WRITE !,"DSS UNIT: "_ECDN,!
- KILL DIC,DIR,DUOUT
- SET DIR(0)="720.3,52.1"
- SET DIR("A")="Select Procedure"
- DO ^DIR
- KILL DIR
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO END
- +1 IF X=""!("@"[X)
- GOTO END
- +2 SET ECFIL="^"_$PIECE(Y,";",2)
- +3 SET ECZERO=@(ECFIL_+Y_",0)")
- SET DSERR=0
- +4 IF $EXTRACT(ECFIL,2)="E"
- Begin DoDot:1
- +5 IF $PIECE($GET(ECZERO),U,3)
- WRITE !,"Selected procedure is inactive at this time.",!
- SET DSERR=1
- QUIT
- End DoDot:1
- IF DSERR
- SET DSERR=0
- GOTO PRO
- +6 IF $EXTRACT(ECFIL,2)="I"
- Begin DoDot:1
- +7 IF '$PIECE($$CPT^ICPTCOD(+Y),"^",7)
- WRITE !,"Selected procedure is inactive at this time.",!
- SET DSERR=1
- End DoDot:1
- IF DSERR
- SET DSERR=0
- GOTO PRO
- +8 SET ECP=Y
- SET ECPN=$PIECE(Y,"^",2)
- +9 WRITE @IOF
- SET ECANS=0
- DO ASK2^ECSCR
- if $DATA(DIRUT)
- GOTO END
- IF '$GET(ECANS)
- DO END1
- WRITE !
- GOTO UNIT
- +10 if '$DATA(ECL)
- DO ^ECSCR
- if '$DATA(ECL)
- GOTO END
- +11 DO ASK
- IF $DATA(DIRUT)!(Y=0)
- DO END2
- GOTO RESEL
- +12 IF $GET(ECLOC)=1
- SET ECLALL=0
- FOR I=0:0
- SET ECLALL=$ORDER(LOC1(ECLALL))
- if 'ECLALL
- QUIT
- SET ECL=$PIECE(LOC1(ECLALL),"^",2)
- SET ECLN=$PIECE(LOC1(ECLALL),"^")
- DO STUFF
- IF ECOUT
- GOTO END
- +13 IF $GET(ECLOC)=0
- SET ECLALL=0
- FOR I=0:0
- SET ECLALL=$ORDER(LOC(ECLALL))
- if 'ECLALL
- QUIT
- SET ECL=$PIECE(LOC(ECLALL),"^",2)
- SET ECLN=$PIECE(LOC(ECLALL),"^")
- DO STUFF
- IF ECOUT
- GOTO END
- RESEL DO MORE
- if X="^"
- GOTO END
- DO END2
- GOTO PRO
- STUFF ; stuff entries
- +1 SET ECCH=ECL_"-"_ECD_"-"_ECC_"-"_ECP
- +2 IF $DATA(^ECJ("B",ECCH))
- DO INACT
- QUIT
- +3 SET X=ECCH
- SET DIC="^ECJ("
- SET DIC(0)="L"
- SET DLAYGO=720.3
- KILL DD,DO
- DO FILE^DICN
- KILL DIC
- +4 SET ECFN=+Y
- +5 WRITE !!,"Entering screen for "_ECLN_" with procedure ",$$NAM^ECSCR,"..."
- +6 SET $PIECE(^ECJ(ECFN,0),"^",3)=DT
- +7 SET $PIECE(^ECJ(ECFN,"PRO"),U)=ECP
- +8 SET DA=ECFN
- SET DIK="^ECJ("
- DO IX^DIK
- +9 SET ^ECJ("AP",ECL,ECD,ECC,ECP,ECFN)=""
- +10 SET ^ECJ("APP",ECL,ECD,ECP,ECFN)=""
- +11 ;
- +12 ;ALB/ESD - Ask procedure reason indicator
- +13 SET DA=ECFN
- SET DIE=720.3
- +14 SET DR=$SELECT($PIECE(ECPCE,"~",2)="N":"",1:"55T//^S X=$G(DEFASCLN);")_"53T;54T;56T"
- +15 DO ^DIE
- KILL DIE,DA,DR
- IF $DATA(Y)
- SET ECOUT=1
- +16 IF $PIECE(ECPCE,"~",2)'="N"
- Begin DoDot:1
- +17 SET DIC="^SC("
- SET DIC(0)="N"
- SET X=$PIECE($GET(^ECJ(ECFN,"PRO")),U,4)
- +18 DO ^DIC
- SET DEFASCLN=$PIECE(Y,U,2)
- KILL DIC
- End DoDot:1
- +19 ;
- +20 ;ALB/ESD - If proc reasons indictor is YES, ask procedure reasons
- +21 IF $PIECE($GET(^ECJ(ECFN,"PRO")),"^",5)=1
- DO ADREAS^ECDSUTIL(ECFN)
- +22 ;
- +23 ;ALB/ESD - Always ask associated clinic and do active clinic check
- +24 ;ALB/JAM - Only ask for associated clinic if DSS Unit sends data to PCE
- +25 IF $PIECE(ECPCE,"~",2)'="N"
- DO CLIN
- +26 QUIT
- MORE WRITE !!,"Press <RET> to continue "
- READ X:DTIME
- if '$TEST
- SET X="^"
- if X="^"
- QUIT
- +1 KILL ECP,Y,ECCH
- +2 WRITE @IOF,!,"Event Code Screen Information:"
- +3 WRITE !,"----------------------------",!
- +4 WRITE !,"DSS Unit: "_ECDN,!,"Category: "_ECCN,!!
- +5 QUIT
- +6 ;
- END ;Kill variables.
- +1 WRITE @IOF
- END1 KILL ECNOPE,ECZERO,DEFASCLN
- DO ^ECKILL
- END2 KILL C,CNT,DIR,DSERR,ECANS,ECFIL,ECL,ECLASS,ECLN,ECP,ECPN,ECS,ECWORK,ECS
- +1 KILL ECZERO,LOC1,NUM,X,Y
- +2 QUIT
- BRO ; check for category use in data entry
- +1 IF '$PIECE(^ECD(ECD,0),U,11)
- SET ECC=0
- SET ECCN="None"
- WRITE !,"Category: "_ECCN,!!
- QUIT
- +2 IF $PIECE(^ECD(ECD,0),U,11)
- Begin DoDot:1
- +3 SET DIC=726
- SET DIC(0)="AEQMZ"
- SET DIC("A")="Select Category : "
- SET DIC("S")="I '$P(^(0),U,3)!(+$P(^(0),U,3)>DT)"
- +4 DO ^DIC
- KILL DIC
- IF Y<0
- SET ECERR=1
- QUIT
- +5 SET ECC=+Y
- SET ECCN=Y(0,0)
- End DoDot:1
- +6 QUIT
- INACT ; check to determine if inactive
- +1 SET ECX=$ORDER(^ECJ("B",ECCH,0))
- IF '$PIECE(^ECJ(ECX,0),"^",2)
- WRITE !!,"This screen has already been created for "_ECLN_"."
- QUIT
- +2 SET Y=$$FMTE^XLFDT($PIECE(^ECJ(ECX,0),"^",2))
- +3 WRITE !!,"This event code for "_ECLN_" inactivated on "_Y_".",!,"Do you want to reactivate it ? NO// "
- READ ECYN:DTIME
- IF '$TEST!(ECYN="^")
- QUIT
- +4 SET ECYN=$EXTRACT(ECYN)
- if ECYN=""
- SET ECYN="N"
- IF "YyNn"'[ECYN
- WRITE !!,"Enter YES if this code should be reactivated for event code",!,"procedures, or <RET> to continue with another procedure."
- GOTO INACT
- +5 if "Nn"[ECYN
- QUIT
- WRITE !!,"Reactivating Event Code Screen... "
- KILL DR,DIE
- SET DA=ECX
- SET DIE="^ECJ("
- SET DR="1///@"
- DO ^DIE
- SET ^ECJ("AP",ECL,ECD,ECC,ECP,DA)=""
- SET ^ECJ("APP",ECL,ECD,ECP,DA)=""
- KILL DR,DIE,DA
- +6 QUIT
- ASK ;Ask user to verify update.
- +1 WRITE !
- SET DIR(0)="Y"
- SET DIR("B")="YES"
- SET DIR("A")="Are you sure that you want to create the screen"
- +2 DO ^DIR
- if $DATA(DIRUT)
- QUIT
- SET ECANS=+Y
- +3 QUIT
- CLIN ;check for active associated clinic
- +1 SET MSG1=1
- SET MSG2=0
- +2 SET EC4=$PIECE($GET(^ECJ(+ECFN,"PRO")),"^",4)
- IF EC4']""
- SET MSG2=1
- +3 DO CLIN^ECPCEU
- +4 IF 'ECPCL
- Begin DoDot:1
- +5 WRITE !!,"The clinic ",$SELECT(MSG1:"associated with",1:"you selected for")," this event code screen ",$SELECT(MSG2:"has not been entered",1:"is inactive"),"."
- +6 WRITE !,"Workload data cannot be sent to PCE for this event code screen with ",!,$SELECT(MSG2:"a missing",1:"an inactive")," clinic."
- +7 WRITE !!,"Please use the Procedure Synonym/Default Volume (Enter/Edit) option to enter",!,"an active clinic.",!!
- End DoDot:1
- +8 SET (MSG1,MSG2)=0
- +9 QUIT