ECXDRG.m

ECXDRG ;ALB/TJL - DRG Report ;4/2/24  15:12

 ;;3.0;DSS EXTRACTS;**190**;Dec 22, 1997;Build 36

 ;

EN ; Entry point from menu option

 N I,X,Y,DIR,ECXPORT

 ;S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1  I ECXPORT D  Q ; The output can only be exported, 

 S ECXPORT=1 D  Q  ; but code to send output to the screen is retained - tjl FY25 - 190

 . K ^TMP($J,"ECXPORT")

 . S ^TMP($J,"ECXPORT",0)="DRG^EFFECTIVE DATE^STATUS^INACTIVE DATE^DRG DESCRIPTION"

 . D EN1

 . M ^TMP($J,"ECXPORT")=^TMP("ECXDRG",$J)

 . D EXPDISP^ECXUTL1

 ;

 ; Queue Report

 W !!,"** Report requires 132 columns to print correctly **",!!

 N ZTDESC,ZTIO,ZTSAVE

 S ZTIO=""

 S ZTDESC="Diagnosis Related Group"

 F I="NAME","EFF DATE","STATUS","INACT DATE" D

 . S ZTSAVE(I)=""

 D EN^XUTMDEVQ("EN1^ECXDRG",ZTDESC,.ZTSAVE)

 Q

EN1 ; Tasked entry point

 ; Declare variables

 N U,DA,LN,DESC,NAME,STAT,INACT,LINEDA,LINECT,NODE0,PAGENUM,NESI

 N DIC,DR,DIQ,CNT,STOP,QFLG,RUNDATE

 K ^TMP("ECXDRG",$J)

 S U="^",$P(LN,"-",132)=""

 S (CNT,QFLG,PAGENUM,STOP)=0

 D NOW^%DTC S Y=$E(%,1,12) S RUNDATE=$$FMTE^XLFDT(Y)

 I '$G(ECXPORT) D HEADER I STOP D EXIT Q

 D GETDATA I $G(ECXPORT) Q  ;Have data, no need to print.

 I '$D(^TMP("ECXDRG",$J)) D  Q

 .W !

 . W !,"+=========================+"

 . W !,"|  No DRG data available  |"

 . W !,"+=========================+"

 . D WAIT

 D DETAIL I STOP D EXIT Q

 K ^TMP("ECXDRG",$J)

 Q

 ;

GETDATA ;

 S DA=0 F  S DA=$O(^ICD(DA)) Q:(+DA=0)  D

 . S CNT=CNT+1

 . S NAME=$P(^ICD(DA,0),U,1)

 . S EFFDA=$O(^ICD(DA,66,9999999),-1)

 . S NODE0=$G(^ICD(DA,66,EFFDA,0))

 . S EFFDT=$$FMTE^XLFDT($P(NODE0,U,1))

 . S STAT=$P(NODE0,U,3)

 . S INACT=$S(STAT=0:EFFDT,1:"")

 . S STAT=$S(STAT=0:"Inactive",1:"Active")

 . S NESI=NAME_U_EFFDT_U_STAT_U_INACT

 . S ^TMP("ECXDRG",$J,CNT)=NESI

 . ; Get description (which may be multiple lines)

 . S DESCDA=$O(^ICD(DA,68,999999),-1)

 . S NODE0=$G(^ICD(DA,68,DESCDA,0))

 . S (LINECT,LINEDA)=0 F  S LINEDA=$O(^ICD(DA,68,DESCDA,1,LINEDA)) Q:'LINEDA  D

 . . I $G(ECXPORT) S:LINEDA>1 CNT=CNT+1 S ^TMP("ECXDRG",$J,CNT)=NESI_U_^ICD(DA,68,DESCDA,1,LINEDA,0) Q

 . . S LINECT=LINECT+1

 . . S ^TMP("ECXDRG",$J,CNT,LINECT)=^ICD(DA,68,DESCDA,1,LINEDA,0)

 . Q

 Q

HEADER ;print header

 S PAGENUM=PAGENUM+1

 W @IOF

 W !,?45,"Diagnosis Related Group (DRG) Report",?120,"Page: ",PAGENUM

 W !,?43,"Report Run Date/Time: "_RUNDATE

 W !!!,"DRG NAME",?35,"EFFECTIVE DATE",?56,"STATUS",?68,"INACTIVATION DATE",!,LN,!

 Q

 ;

DETAIL ;Print detailed line

 ; Input  :  ^TMP("ECXDRG",$J) full global reference

 ; Output :  None

 N RECORD,NODE,DLINE,BLANK

 S RECORD=0 F  S RECORD=$O(^TMP("ECXDRG",$J,RECORD)) Q:'RECORD!(STOP)  D

 . S BLANK=1 S NODE=^TMP("ECXDRG",$J,RECORD)

 . W !,$P(NODE,U,1),?36,$P(NODE,U,2),?56,$P(NODE,U,3),?70,$P(NODE,U,4)

 . W !,"DESCRIPTION:"

 . S DLINE=0 F  S DLINE=$O(^TMP("ECXDRG",$J,RECORD,DLINE)) Q:'DLINE  S BLANK=0 W ?14,^TMP("ECXDRG",$J,RECORD,DLINE),!

 . W:BLANK !

 . I $Y>(IOSL-5) D WAIT Q:STOP  D HEADER

 Q

 ;

WAIT ;End of page logic

 ;Input   ; None

 ;Output  ; STOP - Flag inidcating if printing should continue

 ;                 1 = Stop     0 = Continue

 S STOP=0

 I $E(IOST,1,2)="C-" D  Q    ; CRT - Prompt for continue

 . F  Q:$Y>(IOSL-3)  W !

 . N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT

 . S DIR(0)="E"

 . D ^DIR

 . S STOP=$S(Y'=1:1,1:0)

 S STOP=$$S^%ZTLOAD()   ; Background task - check TaskMan

 I STOP D

 . W !,"**************************************************"

 . W !,"*  Printing of DRG report stopped, as requested  *"

 . W !,"**************************************************"

 Q

EXIT ;Kill temp global

 K ^TMP("ECXDRG",$J)

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ECXDRG   3650     printed  Mar 13, 2025@20:57:05                                                                                                                                                                                                      Page 2

ECXDRG    ;ALB/TJL - DRG Report ;4/2/24  15:12

 +1       ;;3.0;DSS EXTRACTS;**190**;Dec 22, 1997;Build 36

 +2       ;

EN        ; Entry point from menu option

 +1        NEW I,X,Y,DIR,ECXPORT

 +2       ;S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1  I ECXPORT D  Q ; The output can only be exported, 

 +3       ; but code to send output to the screen is retained - tjl FY25 - 190

           SET ECXPORT=1

           Begin DoDot:1

 +4            KILL ^TMP($JOB,"ECXPORT")

 +5            SET ^TMP($JOB,"ECXPORT",0)="DRG^EFFECTIVE DATE^STATUS^INACTIVE DATE^DRG DESCRIPTION"

 +6            DO EN1

 +7            MERGE ^TMP($JOB,"ECXPORT")=^TMP("ECXDRG",$JOB)

 +8            DO EXPDISP^ECXUTL1

           End DoDot:1

           QUIT 

 +9       ;

 +10      ; Queue Report

 +11       WRITE !!,"** Report requires 132 columns to print correctly **",!!

 +12       NEW ZTDESC,ZTIO,ZTSAVE

 +13       SET ZTIO=""

 +14       SET ZTDESC="Diagnosis Related Group"

 +15       FOR I="NAME","EFF DATE","STATUS","INACT DATE"

               Begin DoDot:1

 +16               SET ZTSAVE(I)=""

               End DoDot:1

 +17       DO EN^XUTMDEVQ("EN1^ECXDRG",ZTDESC,.ZTSAVE)

 +18       QUIT 

EN1       ; Tasked entry point

 +1       ; Declare variables

 +2        NEW U,DA,LN,DESC,NAME,STAT,INACT,LINEDA,LINECT,NODE0,PAGENUM,NESI

 +3        NEW DIC,DR,DIQ,CNT,STOP,QFLG,RUNDATE

 +4        KILL ^TMP("ECXDRG",$JOB)

 +5        SET U="^"

           SET $PIECE(LN,"-",132)=""

 +6        SET (CNT,QFLG,PAGENUM,STOP)=0

 +7        DO NOW^%DTC

           SET Y=$EXTRACT(%,1,12)

           SET RUNDATE=$$FMTE^XLFDT(Y)

 +8        IF '$GET(ECXPORT)

               DO HEADER

               IF STOP

                   DO EXIT

                   QUIT 

 +9       ;Have data, no need to print.

           DO GETDATA

           IF $GET(ECXPORT)

               QUIT 

 +10       IF '$DATA(^TMP("ECXDRG",$JOB))

               Begin DoDot:1

 +11               WRITE !

 +12               WRITE !,"+=========================+"

 +13               WRITE !,"|  No DRG data available  |"

 +14               WRITE !,"+=========================+"

 +15               DO WAIT

               End DoDot:1

               QUIT 

 +16       DO DETAIL

           IF STOP

               DO EXIT

               QUIT 

 +17       KILL ^TMP("ECXDRG",$JOB)

 +18       QUIT 

 +19      ;

GETDATA   ;

 +1        SET DA=0

           FOR 

               SET DA=$ORDER(^ICD(DA))

               if (+DA=0)

                   QUIT 

               Begin DoDot:1

 +2                SET CNT=CNT+1

 +3                SET NAME=$PIECE(^ICD(DA,0),U,1)

 +4                SET EFFDA=$ORDER(^ICD(DA,66,9999999),-1)

 +5                SET NODE0=$GET(^ICD(DA,66,EFFDA,0))

 +6                SET EFFDT=$$FMTE^XLFDT($PIECE(NODE0,U,1))

 +7                SET STAT=$PIECE(NODE0,U,3)

 +8                SET INACT=$SELECT(STAT=0:EFFDT,1:"")

 +9                SET STAT=$SELECT(STAT=0:"Inactive",1:"Active")

 +10               SET NESI=NAME_U_EFFDT_U_STAT_U_INACT

 +11               SET ^TMP("ECXDRG",$JOB,CNT)=NESI

 +12      ; Get description (which may be multiple lines)

 +13               SET DESCDA=$ORDER(^ICD(DA,68,999999),-1)

 +14               SET NODE0=$GET(^ICD(DA,68,DESCDA,0))

 +15               SET (LINECT,LINEDA)=0

                   FOR 

                       SET LINEDA=$ORDER(^ICD(DA,68,DESCDA,1,LINEDA))

                       if 'LINEDA

                           QUIT 

                       Begin DoDot:2

 +16                       IF $GET(ECXPORT)

                               if LINEDA>1

                                   SET CNT=CNT+1

                               SET ^TMP("ECXDRG",$JOB,CNT)=NESI_U_^ICD(DA,68,DESCDA,1,LINEDA,0)

                               QUIT 

 +17                       SET LINECT=LINECT+1

 +18                       SET ^TMP("ECXDRG",$JOB,CNT,LINECT)=^ICD(DA,68,DESCDA,1,LINEDA,0)

                       End DoDot:2

 +19               QUIT 

               End DoDot:1

 +20       QUIT 

HEADER    ;print header

 +1        SET PAGENUM=PAGENUM+1

 +2        WRITE @IOF

 +3        WRITE !,?45,"Diagnosis Related Group (DRG) Report",?120,"Page: ",PAGENUM

 +4        WRITE !,?43,"Report Run Date/Time: "_RUNDATE

 +5        WRITE !!!,"DRG NAME",?35,"EFFECTIVE DATE",?56,"STATUS",?68,"INACTIVATION DATE",!,LN,!

 +6        QUIT 

 +7       ;

DETAIL    ;Print detailed line

 +1       ; Input  :  ^TMP("ECXDRG",$J) full global reference

 +2       ; Output :  None

 +3        NEW RECORD,NODE,DLINE,BLANK

 +4        SET RECORD=0

           FOR 

               SET RECORD=$ORDER(^TMP("ECXDRG",$JOB,RECORD))

               if 'RECORD!(STOP)

                   QUIT 

               Begin DoDot:1

 +5                SET BLANK=1

                   SET NODE=^TMP("ECXDRG",$JOB,RECORD)

 +6                WRITE !,$PIECE(NODE,U,1),?36,$PIECE(NODE,U,2),?56,$PIECE(NODE,U,3),?70,$PIECE(NODE,U,4)

 +7                WRITE !,"DESCRIPTION:"

 +8                SET DLINE=0

                   FOR 

                       SET DLINE=$ORDER(^TMP("ECXDRG",$JOB,RECORD,DLINE))

                       if 'DLINE

                           QUIT 

                       SET BLANK=0

                       WRITE ?14,^TMP("ECXDRG",$JOB,RECORD,DLINE),!

 +9                if BLANK

                       WRITE !

 +10               IF $Y>(IOSL-5)

                       DO WAIT

                       if STOP

                           QUIT 

                       DO HEADER

               End DoDot:1

 +11       QUIT 

 +12      ;

WAIT      ;End of page logic

 +1       ;Input   ; None

 +2       ;Output  ; STOP - Flag inidcating if printing should continue

 +3       ;                 1 = Stop     0 = Continue

 +4        SET STOP=0

 +5       ; CRT - Prompt for continue

           IF $EXTRACT(IOST,1,2)="C-"

               Begin DoDot:1

 +6                FOR 

                       if $Y>(IOSL-3)

                           QUIT 

                       WRITE !

 +7                NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT

 +8                SET DIR(0)="E"

 +9                DO ^DIR

 +10               SET STOP=$SELECT(Y'=1:1,1:0)

               End DoDot:1

               QUIT 

 +11      ; Background task - check TaskMan

           SET STOP=$$S^%ZTLOAD()

 +12       IF STOP

               Begin DoDot:1

 +13               WRITE !,"**************************************************"

 +14               WRITE !,"*  Printing of DRG report stopped, as requested  *"

 +15               WRITE !,"**************************************************"

               End DoDot:1

 +16       QUIT 

EXIT      ;Kill temp global

 +1        KILL ^TMP("ECXDRG",$JOB)

 +2        QUIT 

 +3       ;