- ECRDSSEC ;ALB/DAN - Event capture screen for DSS unit report ;1/25/16 12:02
- ;;2.0;EVENT CAPTURE;**112,131**;8 May 96;Build 13
- ;
- STRPT ;Main entry point for report
- N NODE,PRO,CNT,LOC,CAT,IEN,PX,PN,CATD,LOCDS,ECL,ECSYN,ACT,DEFCL
- K ^TMP($J,"ECRPT")
- S (CNT,LOC)=0
- S CNT=CNT+1,^TMP($J,"ECRPT",CNT)="SYNONYM^PROCEDURE^LOCATION^DEFAULT ASSOCIATED CLINIC^CATEGORY^STATUS"
- F S LOC=$O(^ECJ("AP",LOC)) Q:'LOC S CAT="" D
- .I ECD'="" D:$D(^ECJ("AP",LOC,ECD)) GETSCN Q
- I ECPTYP="E" Q ;Stop if exporting and not printing.
- U IO
- D HDR
- S CNT=1
- F S CNT=$O(^TMP($J,"ECRPT",CNT)) Q:'+CNT D
- .S NODE=^TMP($J,"ECRPT",CNT)
- .W $E($P(NODE,U),1,20),?22,$E($P(NODE,U,2),1,25),?49,$E($P(NODE,U,3),1,25),?76,$E($P(NODE,U,4),1,25),?103,$E($P(NODE,U,5),1,25),?123,$P(NODE,U,6),!
- .I $Y>(IOSL-5) D HDR
- Q
- GETSCN F S CAT=$O(^ECJ("AP",LOC,ECD,CAT)) Q:CAT="" S PX="" D
- .I CAT,'$P(^ECD(ECD,0),U,11) Q ;131 Don't show screen if it has a category and the DSS Unit is set to "no categories"
- .F S PX=$O(^ECJ("AP",LOC,ECD,CAT,PX)) Q:PX="" S IEN=0 D
- ..F S IEN=$O(^ECJ("AP",LOC,ECD,CAT,PX,IEN)) Q:'IEN D
- ...S NODE=$G(^ECJ(IEN,0)) I NODE="" Q
- ...S ACT=$P(NODE,U,2)
- ...I $S(STAT="A"&(ACT'=""):1,STAT="I"&(ACT=""):1,1:0) Q ;filter by status
- ...S PRO=$G(^ECJ(IEN,"PRO")),ECSYN=$P(PRO,U,2),PN=$P($P(PRO,U),";"),DEFCL=$P(PRO,U,4)
- ...I PN="" Q
- ...I $P(PRO,U)["EC" S PN=$G(^EC(725,PN,0)),PRO=$P(PN,U,2)_" "_$P(PN,U)
- ...E S PN=$$CPT^ICPTCOD(PN) S PRO=$P(PN,U,2)_" "_$P(PN,U,3)
- ...S ACT=$S(ACT'="":"Inactive",1:"Active")
- ...S CATD=$S('CAT:"None",1:$P($G(^EC(726,CAT,0)),U))
- ...S LOCDS=$$GET1^DIQ(4,LOC,.01,"I"),CNT=CNT+1
- ...I DEFCL'="" S DEFCL=$$GET1^DIQ(44,DEFCL,".01")
- ...S ^TMP($J,"ECRPT",CNT)=ECSYN_U_PRO_U_LOCDS_U_DEFCL_U_CATD_U_ACT
- Q
- ;
- HDR ;
- I $D(IOF) W @IOF
- W !,"EVENT SCREENS FOR DSS UNIT:",$$GET1^DIQ(724,ECD,".01"),?$S($G(IOM):(IOM-18),1:62),$$FMTE^XLFDT($$NOW^XLFDT,"1M"),!!
- W !,"SYNONYM",?22,"PROCEDURE",?49,"LOCATION",?76,"ASSOC. CLINIC",?103,"CATEGORY",?123,"STATUS",!,$$REPEAT^XLFSTR("-",$S($G(IOM):IOM,1:132)),!
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECRDSSEC 2064 printed Feb 18, 2025@23:24:55 Page 2
- ECRDSSEC ;ALB/DAN - Event capture screen for DSS unit report ;1/25/16 12:02
- +1 ;;2.0;EVENT CAPTURE;**112,131**;8 May 96;Build 13
- +2 ;
- STRPT ;Main entry point for report
- +1 NEW NODE,PRO,CNT,LOC,CAT,IEN,PX,PN,CATD,LOCDS,ECL,ECSYN,ACT,DEFCL
- +2 KILL ^TMP($JOB,"ECRPT")
- +3 SET (CNT,LOC)=0
- +4 SET CNT=CNT+1
- SET ^TMP($JOB,"ECRPT",CNT)="SYNONYM^PROCEDURE^LOCATION^DEFAULT ASSOCIATED CLINIC^CATEGORY^STATUS"
- +5 FOR
- SET LOC=$ORDER(^ECJ("AP",LOC))
- if 'LOC
- QUIT
- SET CAT=""
- Begin DoDot:1
- +6 IF ECD'=""
- if $DATA(^ECJ("AP",LOC,ECD))
- DO GETSCN
- QUIT
- End DoDot:1
- +7 ;Stop if exporting and not printing.
- IF ECPTYP="E"
- QUIT
- +8 USE IO
- +9 DO HDR
- +10 SET CNT=1
- +11 FOR
- SET CNT=$ORDER(^TMP($JOB,"ECRPT",CNT))
- if '+CNT
- QUIT
- Begin DoDot:1
- +12 SET NODE=^TMP($JOB,"ECRPT",CNT)
- +13 WRITE $EXTRACT($PIECE(NODE,U),1,20),?22,$EXTRACT($PIECE(NODE,U,2),1,25),?49,$EXTRACT($PIECE(NODE,U,3),1,25),?76,$EXTRACT($PIECE(NODE,U,4),1,25),?103,$EXTRACT($PIECE(NODE,U,5),1,25),?123,$PIECE(NODE,U,6),!
- +14 IF $Y>(IOSL-5)
- DO HDR
- End DoDot:1
- +15 QUIT
- GETSCN FOR
- SET CAT=$ORDER(^ECJ("AP",LOC,ECD,CAT))
- if CAT=""
- QUIT
- SET PX=""
- Begin DoDot:1
- +1 ;131 Don't show screen if it has a category and the DSS Unit is set to "no categories"
- IF CAT
- IF '$PIECE(^ECD(ECD,0),U,11)
- QUIT
- +2 FOR
- SET PX=$ORDER(^ECJ("AP",LOC,ECD,CAT,PX))
- if PX=""
- QUIT
- SET IEN=0
- Begin DoDot:2
- +3 FOR
- SET IEN=$ORDER(^ECJ("AP",LOC,ECD,CAT,PX,IEN))
- if 'IEN
- QUIT
- Begin DoDot:3
- +4 SET NODE=$GET(^ECJ(IEN,0))
- IF NODE=""
- QUIT
- +5 SET ACT=$PIECE(NODE,U,2)
- +6 ;filter by status
- IF $SELECT(STAT="A"&(ACT'=""):1,STAT="I"&(ACT=""):1,1:0)
- QUIT
- +7 SET PRO=$GET(^ECJ(IEN,"PRO"))
- SET ECSYN=$PIECE(PRO,U,2)
- SET PN=$PIECE($PIECE(PRO,U),";")
- SET DEFCL=$PIECE(PRO,U,4)
- +8 IF PN=""
- QUIT
- +9 IF $PIECE(PRO,U)["EC"
- SET PN=$GET(^EC(725,PN,0))
- SET PRO=$PIECE(PN,U,2)_" "_$PIECE(PN,U)
- +10 IF '$TEST
- SET PN=$$CPT^ICPTCOD(PN)
- SET PRO=$PIECE(PN,U,2)_" "_$PIECE(PN,U,3)
- +11 SET ACT=$SELECT(ACT'="":"Inactive",1:"Active")
- +12 SET CATD=$SELECT('CAT:"None",1:$PIECE($GET(^EC(726,CAT,0)),U))
- +13 SET LOCDS=$$GET1^DIQ(4,LOC,.01,"I")
- SET CNT=CNT+1
- +14 IF DEFCL'=""
- SET DEFCL=$$GET1^DIQ(44,DEFCL,".01")
- +15 SET ^TMP($JOB,"ECRPT",CNT)=ECSYN_U_PRO_U_LOCDS_U_DEFCL_U_CATD_U_ACT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +16 QUIT
- +17 ;
- HDR ;
- +1 IF $DATA(IOF)
- WRITE @IOF
- +2 WRITE !,"EVENT SCREENS FOR DSS UNIT:",$$GET1^DIQ(724,ECD,".01"),?$SELECT($GET(IOM):(IOM-18),1:62),$$FMTE^XLFDT($$NOW^XLFDT,"1M"),!!
- +3 WRITE !,"SYNONYM",?22,"PROCEDURE",?49,"LOCATION",?76,"ASSOC. CLINIC",?103,"CATEGORY",?123,"STATUS",!,$$REPEAT^XLFSTR("-",$SELECT($GET(IOM):IOM,1:132)),!
