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))
Q
;
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
Q
;
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
Q
;
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)
Q
;
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
Q
;
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,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXAPRO2 4951 printed Dec 13, 2024@01:52:11 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 ;
+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
