Routine: ECXAPRO2

ECXAPRO2 ;ALB/JAP - PRO Extract Audit Report (cont) ;12/4/19  09:48

 ;;3.0;DSS EXTRACTS;**9,21,39,144,154,174,177**;Dec 22, 1997;Build 2

ASK ;further detail needed?

 K X,Y

W !

 S DIR(0)="Y",DIR("A")="Do you want to see details on this audit report",DIR("B")="NO"

 D ^DIR K DIR

 Q:($G(Y)=0)!$D(DUOUT)!($D(DTOUT))

 ;allow user to expand as many lines as needed

 F  D ASK2 Q:$D(DUOUT)!($D(DTOUT))

ASK2 ;select nppd group to be expanded

 D CODE

 W @IOF,!

 W !,?5,"1.   WHEELCHAIRS AND ACCESSORIES"

 W !,?5,"2.   ARTIFICIAL LEGS"

 W !,?5,"3.   ARTIFICIAL ARMS AND TERMINAL DEVICES"

 W !,?5,"4.   BRACES AND ORTHOTICS"

 W !,?5,"5.   SHOES/ORTHOTICS"

 W !,?5,"6.   NEUROSENSORY AIDS"

 W !,?5,"7.   RESTORATIONS"

 W !,?5,"8.   OXYGEN AND RESPIRATORY"

 W !,?5,"9.   MEDICAL EQUIPMENT, MISC., ALL OTHER NEW"

 W !,?5,"10.  REPAIR",!!

 S DIR(0)="N^1:10:0"

 S DIR("A")="Select NPPD Group "

 D ^DIR K DIR

 Q:$D(DUOUT)!($D(DTOUT))

 D ASK3(Y)

 Q:$D(DTOUT)

 K DIRUT,DTOUT,DUOUT

 G ASK2

ASK3(ECXY) ;select nppd line item

 N BR,BRC,CODE,CNT,ECXPORT ;144

 S BR=0,BRC=0 K CODE W @IOF

 F  S BR=$O(^TMP($J,"RMPRCODE",BR)) Q:BR=""  I $L(BR)>3 D

 .I $E(BR,1,1)=ECXY S BRC=BRC+1 W !?5,BRC_".",?10,BR,?18,^TMP($J,"RMPRCODE",BR) S CODE(BRC,BR)=""

 .I ($E(BR,1,1)="R")&(ECXY=10) S BRC=BRC+1 W !?5,BRC_".",?10,BR,?18,^TMP($J,"RMPRCODE",BR) S CODE(BRC,BR)=""

W !

 S DIR(0)="N^1:"_BRC_":0"

 S DIR("A")="Select NPPD Line "

 D ^DIR K DIR

 Q:$D(DUOUT)!($D(DTOUT))

 S ECXCODE="",ECXCODE=$O(CODE(Y,ECXCODE))

 S ECXPGM="TASK^ECXAPRO",ECXDESC="PRO Extract Audit Detail"

 S ECXSAVE("ECXHEAD")="",ECXSAVE("ECXDIV(")="",ECXSAVE("ECXARRAY(")="",ECXSAVE("ECXREPT")="",ECXSAVE("ECXPRIME")="",ECXSAVE("ECXALL")="",ECXSAVE("ECXCODE")=""

 S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1  I ECXPORT D  Q  ;144

 .K ^TMP($J) ;144

 .S ^TMP($J,"ECXPORT",0)="EXTRACT LOG #^NPPD GROUP^NPPD LINE^NAME^SSN^HCPCS^QTY^TYPE^COST^DATE^HCPCS DESC^STATION #^NPPD ENTRY DATE" ;144

 .S CNT=1 ;144

 .D PROCESS^ECXAPRO ;144

 .D DISP ;144

 .D EXPDISP^ECXUTL1

W !

 ;determine output device and queue if requested

 D DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE) I ECXSAVE("POP")=1 D  Q

 .W !!,?5,"Try again later... exiting.",!

 I ECXSAVE("ZTSK")=0 D

 .K ECXSAVE,ECXPGM,ECXDESC

 .I '$D(^TMP($J,"RMPRGN")) D PROCESS^ECXAPRO

 .D DISP

 I $D(IO(0)) I IO(0)'=IO D ^%ZISC

 D HOME^%ZIS

CODE ;setup nppd codes

 ;intended to duplicate code^rmprn63

 N NULINE

 Q:$D(^TMP($J,"RMPRCODE"))

 F I=1:1 S NULINE=$P($T(TEXT+I^ECXAPRO3),";;",2) Q:NULINE["QUIT"  D

 .S ^TMP($J,"RMPRCODE",$P(NULINE,";",1))=$P(NULINE,";",2)

DISP ;display all records within nppd code group

 ;based on desp^rmprn6pl

 N JJ,SS,LN,PG,COST,DATE,DESC,HCPCS,LOC,PTNAM,QFLG,QTY,RDX,RDXX,SSN,TYPE,DIR,DIRUT,DTOUT,DUOUT,NPPDED ;NPPD ENT DATE CVW 144

 U IO

 S (QFLG,PG)=0,$P(LN,"-",81)=""

 I '$G(ECXPORT) D HEADER ;144

 I '$D(^TMP($J,ECXCODE)) D  Q

 .I $G(ECXPORT) Q  ;144 Stop processing if exporting

 .W !,?14,"No data available.",!

 .I $E(IOST)="C",'QFLG D

 ..S SS=22-$Y F JJ=1:1:SS W !

 ..S DIR(0)="E" D ^DIR K DIR

 S RDX=0

 F  S RDX=$O(^TMP($J,ECXCODE,RDX)) Q:RDX'>0  Q:QFLG  D

 .S RDXX=^TMP($J,ECXCODE,RDX)

 .S PTNAM=$P(RDXX,U,9),SSN=$P(RDXX,U,10)

 .I '$G(ECXPORT) D:($Y+3>IOSL) HEADER Q:QFLG  ;144 Don't display if exporting

 .S TYPE=$P(RDXX,U,1),TYPE=$S(TYPE="X":"R",1:"I")_" "_$P(RDXX,U,2)

 .S QTY=+$P(RDXX,U,3),COST=$P(RDXX,U,4),HCPCS=$P(RDXX,U,7),DESC=$P(RDXX,U,8),DATE=$P(RDXX,U,11),LOC=$P(RDXX,U,12),NPPDED=$P(RDXX,U,13) ;144 CVW

 .I $G(ECXPORT) S ^TMP($J,"ECXPORT",CNT)=ECXEXT_U_ECXCODE_U_^TMP($J,"RMPRCODE",ECXCODE)_U_PTNAM_U_SSN_U_HCPCS_U_QTY_U_TYPE_U_COST_U_DATE_U_DESC_U_LOC_U_NPPDED,CNT=CNT+1 Q  ;144

 .W !,PTNAM,?5,SSN,?10,HCPCS,?17,QTY,?26,TYPE,?30,COST,?37,DATE,?43,DESC,?64,LOC,?72,NPPDED ;144 CVW

 I $G(ECXPORT)!(QFLG) Q  ;144,177 Stop processing if exporting or user entered '^'

 D:($Y+4>IOSL) HEADER W:'QFLG !!,"NOTE: For Vista records with Unit of Issue=MO, the extract Unit of Issue",!,"and Quantity have been converted from months to days." ;174,177

 I $E(IOST)="C",'QFLG D

 .S SS=22-$Y F JJ=1:1:SS W !

 .S DIR(0)="E" D ^DIR K DIR

HEADER ;header and page control

 I $E(IOST)="C" D

 .S SS=22-$Y F JJ=1:1:SS W !

 .I PG>0 S DIR(0)="E" D ^DIR K DIR S:'Y QFLG=1

 Q:QFLG

 W:$Y!($E(IOST)="C") @IOF S PG=PG+1

 W !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report Detail",?72,"Page ",PG

 W !,"DSS Extract Log #:       "_ECXEXT

 W !,"Date Range of Audit:     "_ECXARRAY("START")_" to "_ECXARRAY("END")

 I ECXALL=1 W !,"Station:                 "_$P(ECXDIV,U,2)_" ("_$P(ECXDIV,U,3)_")"

 I ECXALL=0 W !,"Division:                "_$P(ECXDIV,U,2)_" ("_$P(ECXDIV,U,3)_")"

 W !,"Report Run Date/Time:    "_ECXRUN

 W !,LN,!,ECXCODE," -- ",^TMP($J,"RMPRCODE",ECXCODE),?74,"NPPD"

 W !,"NAME",?5,"SSN",?10,"HCPCS",?17,"QTY",?26,"TYP",?30,"COST",?37,"DATE",?43,"HCPCS DESC",?64,"STN#",?72,"ENTRY DT"

 W !,LN,!

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXAPRO2   4951     printed  Mar 13, 2025@20:56:51                                                                                                                                                                                                    Page 2

ECXAPRO2  ;ALB/JAP - PRO Extract Audit Report (cont) ;12/4/19  09:48

 +1       ;;3.0;DSS EXTRACTS;**9,21,39,144,154,174,177**;Dec 22, 1997;Build 2

 +2       ;

ASK       ;further detail needed?

 +1        KILL X,Y

 +2        WRITE !

 +3        SET DIR(0)="Y"

           SET DIR("A")="Do you want to see details on this audit report"

           SET DIR("B")="NO"

 +4        DO ^DIR

           KILL DIR

 +5        if ($GET(Y)=0)!$DATA(DUOUT)!($DATA(DTOUT))

               QUIT

 +6       ;allow user to expand as many lines as needed

 +7        FOR

               DO ASK2

               if $DATA(DUOUT)!($DATA(DTOUT))

                   QUIT

 +8        QUIT

 +9       ;

ASK2      ;select nppd group to be expanded

 +1        DO CODE

 +2        WRITE @IOF,!

 +3        WRITE !,?5,"1.   WHEELCHAIRS AND ACCESSORIES"

 +4        WRITE !,?5,"2.   ARTIFICIAL LEGS"

 +5        WRITE !,?5,"3.   ARTIFICIAL ARMS AND TERMINAL DEVICES"

 +6        WRITE !,?5,"4.   BRACES AND ORTHOTICS"

 +7        WRITE !,?5,"5.   SHOES/ORTHOTICS"

 +8        WRITE !,?5,"6.   NEUROSENSORY AIDS"

 +9        WRITE !,?5,"7.   RESTORATIONS"

 +10       WRITE !,?5,"8.   OXYGEN AND RESPIRATORY"

 +11       WRITE !,?5,"9.   MEDICAL EQUIPMENT, MISC., ALL OTHER NEW"

 +12       WRITE !,?5,"10.  REPAIR",!!

 +13       SET DIR(0)="N^1:10:0"

 +14       SET DIR("A")="Select NPPD Group "

 +15       DO ^DIR

           KILL DIR

 +16       if $DATA(DUOUT)!($DATA(DTOUT))

               QUIT

 +17       DO ASK3(Y)

 +18       if $DATA(DTOUT)

               QUIT

 +19       KILL DIRUT,DTOUT,DUOUT

 +20       GOTO ASK2

 +21       QUIT

 +22      ;

ASK3(ECXY) ;select nppd line item

 +1       ;144

           NEW BR,BRC,CODE,CNT,ECXPORT

 +2        SET BR=0

           SET BRC=0

           KILL CODE

           WRITE @IOF

 +3        FOR

               SET BR=$ORDER(^TMP($JOB,"RMPRCODE",BR))

               if BR=""

                   QUIT

               IF $LENGTH(BR)>3

                   Begin DoDot:1

 +4                    IF $EXTRACT(BR,1,1)=ECXY

                           SET BRC=BRC+1

                           WRITE !?5,BRC_".",?10,BR,?18,^TMP($JOB,"RMPRCODE",BR)

                           SET CODE(BRC,BR)=""

 +5                    IF ($EXTRACT(BR,1,1)="R")&(ECXY=10)

                           SET BRC=BRC+1

                           WRITE !?5,BRC_".",?10,BR,?18,^TMP($JOB,"RMPRCODE",BR)

                           SET CODE(BRC,BR)=""

                   End DoDot:1

 +6        WRITE !

 +7        SET DIR(0)="N^1:"_BRC_":0"

 +8        SET DIR("A")="Select NPPD Line "

 +9        DO ^DIR

           KILL DIR

 +10       if $DATA(DUOUT)!($DATA(DTOUT))

               QUIT

 +11       SET ECXCODE=""

           SET ECXCODE=$ORDER(CODE(Y,ECXCODE))

 +12       SET ECXPGM="TASK^ECXAPRO"

           SET ECXDESC="PRO Extract Audit Detail"

 +13       SET ECXSAVE("ECXHEAD")=""

           SET ECXSAVE("ECXDIV(")=""

           SET ECXSAVE("ECXARRAY(")=""

           SET ECXSAVE("ECXREPT")=""

           SET ECXSAVE("ECXPRIME")=""

           SET ECXSAVE("ECXALL")=""

           SET ECXSAVE("ECXCODE")=""

 +14      ;144

           SET ECXPORT=$$EXPORT^ECXUTL1

           if ECXPORT=-1

               QUIT

           IF ECXPORT

               Begin DoDot:1

 +15      ;144

                   KILL ^TMP($JOB)

 +16      ;144

                   SET ^TMP($JOB,"ECXPORT",0)="EXTRACT LOG #^NPPD GROUP^NPPD LINE^NAME^SSN^HCPCS^QTY^TYPE^COST^DATE^HCPCS DESC^STATION #^NPPD ENTRY DATE"

 +17      ;144

                   SET CNT=1

 +18      ;144

                   DO PROCESS^ECXAPRO

 +19      ;144

                   DO DISP

 +20               DO EXPDISP^ECXUTL1

               End DoDot:1

               QUIT

 +21       WRITE !

 +22      ;determine output device and queue if requested

 +23       DO DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE)

           IF ECXSAVE("POP")=1

               Begin DoDot:1

 +24               WRITE !!,?5,"Try again later... exiting.",!

               End DoDot:1

               QUIT

 +25       IF ECXSAVE("ZTSK")=0

               Begin DoDot:1

 +26               KILL ECXSAVE,ECXPGM,ECXDESC

 +27               IF '$DATA(^TMP($JOB,"RMPRGN"))

                       DO PROCESS^ECXAPRO

 +28               DO DISP

               End DoDot:1

 +29       IF $DATA(IO(0))

               IF IO(0)'=IO

                   DO ^%ZISC

 +30       DO HOME^%ZIS

 +31       QUIT

 +32      ;

CODE      ;setup nppd codes

 +1       ;intended to duplicate code^rmprn63

 +2        NEW NULINE

 +3        if $DATA(^TMP($JOB,"RMPRCODE"))

               QUIT

 +4        FOR I=1:1

               SET NULINE=$PIECE($TEXT(TEXT+I^ECXAPRO3),";;",2)

               if NULINE["QUIT"

                   QUIT

               Begin DoDot:1

 +5                SET ^TMP($JOB,"RMPRCODE",$PIECE(NULINE,";",1))=$PIECE(NULINE,";",2)

               End DoDot:1

 +6        QUIT

 +7       ;

DISP      ;display all records within nppd code group

 +1       ;based on desp^rmprn6pl

 +2       ;NPPD ENT DATE CVW 144

           NEW JJ,SS,LN,PG,COST,DATE,DESC,HCPCS,LOC,PTNAM,QFLG,QTY,RDX,RDXX,SSN,TYPE,DIR,DIRUT,DTOUT,DUOUT,NPPDED

 +3        USE IO

 +4        SET (QFLG,PG)=0

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

 +5       ;144

           IF '$GET(ECXPORT)

               DO HEADER

 +6        IF '$DATA(^TMP($JOB,ECXCODE))

               Begin DoDot:1

 +7       ;144 Stop processing if exporting

                   IF $GET(ECXPORT)

                       QUIT

 +8                WRITE !,?14,"No data available.",!

 +9                IF $EXTRACT(IOST)="C"

                       IF 'QFLG

                           Begin DoDot:2

 +10                           SET SS=22-$Y

                               FOR JJ=1:1:SS

                                   WRITE !

 +11                           SET DIR(0)="E"

                               DO ^DIR

                               KILL DIR

                           End DoDot:2

               End DoDot:1

               QUIT

 +12       SET RDX=0

 +13       FOR

               SET RDX=$ORDER(^TMP($JOB,ECXCODE,RDX))

               if RDX'>0

                   QUIT

               if QFLG

                   QUIT

               Begin DoDot:1

 +14               SET RDXX=^TMP($JOB,ECXCODE,RDX)

 +15               SET PTNAM=$PIECE(RDXX,U,9)

                   SET SSN=$PIECE(RDXX,U,10)

 +16      ;144 Don't display if exporting

                   IF '$GET(ECXPORT)

                       if ($Y+3>IOSL)

                           DO HEADER

                       if QFLG

                           QUIT

 +17               SET TYPE=$PIECE(RDXX,U,1)

                   SET TYPE=$SELECT(TYPE="X":"R",1:"I")_" "_$PIECE(RDXX,U,2)

 +18      ;144 CVW

                   SET QTY=+$PIECE(RDXX,U,3)

                   SET COST=$PIECE(RDXX,U,4)

                   SET HCPCS=$PIECE(RDXX,U,7)

                   SET DESC=$PIECE(RDXX,U,8)

                   SET DATE=$PIECE(RDXX,U,11)

                   SET LOC=$PIECE(RDXX,U,12)

                   SET NPPDED=$PIECE(RDXX,U,13)

 +19      ;144

                   IF $GET(ECXPORT)

                       SET ^TMP($JOB,"ECXPORT",CNT)=ECXEXT_U_ECXCODE_U_^TMP($JOB,"RMPRCODE",ECXCODE)_U_PTNAM_U_SSN_U_HCPCS_U_QTY_U_TYPE_U_COST_U_DATE_U_DESC_U_LOC_U_NPPDED

                       SET CNT=CNT+1

                       QUIT

 +20      ;144 CVW

                   WRITE !,PTNAM,?5,SSN,?10,HCPCS,?17,QTY,?26,TYPE,?30,COST,?37,DATE,?43,DESC,?64,LOC,?72,NPPDED

               End DoDot:1

 +21      ;144,177 Stop processing if exporting or user entered '^'

           IF $GET(ECXPORT)!(QFLG)

               QUIT

 +22      ;174,177

           if ($Y+4>IOSL)

               DO HEADER

           if 'QFLG

               WRITE !!,"NOTE: For Vista records with Unit of Issue=MO, the extract Unit of Issue",!,"and Quantity have been converted from months to days."

 +23       IF $EXTRACT(IOST)="C"

               IF 'QFLG

                   Begin DoDot:1

 +24                   SET SS=22-$Y

                       FOR JJ=1:1:SS

                           WRITE !

 +25                   SET DIR(0)="E"

                       DO ^DIR

                       KILL DIR

                   End DoDot:1

 +26       QUIT

 +27      ;

HEADER    ;header and page control

 +1        IF $EXTRACT(IOST)="C"

               Begin DoDot:1

 +2                SET SS=22-$Y

                   FOR JJ=1:1:SS

                       WRITE !

 +3                IF PG>0

                       SET DIR(0)="E"

                       DO ^DIR

                       KILL DIR

                       if 'Y

                           SET QFLG=1

               End DoDot:1

 +4        if QFLG

               QUIT

 +5        if $Y!($EXTRACT(IOST)="C")

               WRITE @IOF

           SET PG=PG+1

 +6        WRITE !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report Detail",?72,"Page ",PG

 +7        WRITE !,"DSS Extract Log #:       "_ECXEXT

 +8        WRITE !,"Date Range of Audit:     "_ECXARRAY("START")_" to "_ECXARRAY("END")

 +9        IF ECXALL=1

               WRITE !,"Station:                 "_$PIECE(ECXDIV,U,2)_" ("_$PIECE(ECXDIV,U,3)_")"

 +10       IF ECXALL=0

               WRITE !,"Division:                "_$PIECE(ECXDIV,U,2)_" ("_$PIECE(ECXDIV,U,3)_")"

 +11       WRITE !,"Report Run Date/Time:    "_ECXRUN

 +12       WRITE !,LN,!,ECXCODE," -- ",^TMP($JOB,"RMPRCODE",ECXCODE),?74,"NPPD"

 +13       WRITE !,"NAME",?5,"SSN",?10,"HCPCS",?17,"QTY",?26,"TYP",?30,"COST",?37,"DATE",?43,"HCPCS DESC",?64,"STN#",?72,"ENTRY DT"

 +14       WRITE !,LN,!

 +15       QUIT

ECXAPRO2.m