PSODEARU ;WILM/BDB - EPCS Utilities and Reports; [5/7/02 5:53am] ;10/5/21 14:50
;;7.0;OUTPATIENT PHARMACY;**667,545,731**;DEC 1997;Build 18
;External reference to DEA NUMBERS file (#8991.9) is supported by DBIA 7002
;External reference to XUEPCS DATA file (#8991.6) is supported by DBIA 7015
;External reference to XUEPCS PSDRPH AUDIT file (#8991.7) is supported by DBIA 7016
;External reference to KEYS sub-file (#200.051) is supported by DBIA 7054
;
Q
;
OENDL(PSONS,BDT,EDT,FN) ;
I '+$G(GUIFLAG) K IOP,%ZIS S PSOION=ION,%ZIS="M" D ^%ZIS I POP S IOP=PSOION D ^%ZIS Q
N PAGE,LINE,LEN,XTV,ARR,I,J,RHD,HCL,FSP,RDT,DV,DVS,FE
N HEADER,DIVDA,PSODIV,START,DA,DATA,IEN K DIRUT
N PROVNAME,EDITOR,FLDNAME,OLDVAL,NEWVAL,EDITDATE,DEA,SRCFILE
K ^XTMP(PSONS,$J),^TMP($J,"EPCSRPT")
S LD=BDT F S LD=$O(^XTV(FN,"DT",LD)) Q:'LD!(LD>EDT) D
. S ND=0 F S ND=$O(^XTV(FN,"DT",LD,ND)) Q:'ND D
.. Q:'$D(^XTV(FN,ND,0))
.. S DAT=^XTV(FN,ND,0)
.. I FN=8991.6 I $P(DAT,"^",3)=.03 Q ;P731 detox/x-waiver removal
.. S IEN=$P(DAT,"^")
.. S (DV,DVS)=0 F S DV=$O(^VA(200,IEN,2,DV)) Q:('DV)&(DVS>0) S:'DV DV=999999 D
... S DVS=DVS+1
... S ^XTMP(PSONS,$J,DV,LD,ND)=""
I '$D(^XTMP(PSONS,$J)) D Q
. U IO W !," *************** NO MATCHING DATA ***************",!!
S HEADER="Division^Provider Name^Edited by Name^Field Name^Original Data^Edited Data^Source File^Date Edited^DEA Number"
I +$G(GUIFLAG) S ROW=1 S ^TMP($J,"EPCSRPT",ROW)=HEADER
I '+$G(GUIFLAG) U IO W !,$TR(HEADER,"^","|")
S DIVDA="" F S DIVDA=$O(^XTMP(PSONS,$J,DIVDA)) Q:'DIVDA D
. S PSODIV=$S(DIVDA=999999:"NO DIVISION",1:$$GET1^DIQ(4,DIVDA,.01))
. S START=0 F S START=$O(^XTMP(PSONS,$J,DIVDA,START)) Q:'START D Q:$D(DIRUT)
.. S DA=0 F S DA=$O(^XTMP(PSONS,$J,DIVDA,START,DA)) Q:'DA D Q:$D(DIRUT)
... S DATA=^XTV(FN,DA,0),IEN=$P(DATA,"^"),FE=$P(DATA,"^",3)
... D GETS^DIQ(FN,DA,".01;.02;.03;.04;.05;.06;.08","E","XTV")
... S PROVNAME=$G(XTV(FN,DA_",",.01,"E"))
... S EDITOR=$G(XTV(FN,DA_",",.02,"E"))
... S FLDNAME=$P($G(^DD($S(FE>50:200,1:8991.9),FE,0)),U)
... I FE=.04 D
.... S Y=$P(DATA,"^",4) X ^DD("DD") S OLDVAL=Y
.... S Y=$P(DATA,"^",5) X ^DD("DD") S NEWVAL=Y
... I FE'=.04 D
.... S OLDVAL=$S($G(XTV(FN,DA_",",.04,"E"))="True":1,$G(XTV(FN,DA_",",.04,"E"))="False":0,1:$G(XTV(FN,DA_",",.04,"E")))
.... S NEWVAL=$S($G(XTV(FN,DA_",",.05,"E"))="True":1,$G(XTV(FN,DA_",",.05,"E"))="False":0,1:$G(XTV(FN,DA_",",.05,"E")))
... S SRCFILE=$S(FE>50:200,1:8991.9)
... S Y=$P($P(DATA,"^",6),".",1) X ^DD("DD") S EDITDATE=Y
... S DEA=$P(DATA,"^",8)
... S RECORD=PSODIV_U_PROVNAME_U_EDITOR_U_FLDNAME_U_OLDVAL_U_NEWVAL_U_SRCFILE_U_EDITDATE_U_DEA
... I +$G(GUIFLAG) S ROW=ROW+1 S ^TMP($J,"EPCSRPT",ROW)=RECORD
... I '+$G(GUIFLAG) W !,$TR(RECORD,"^","|")
I '+$G(GUIFLAG) W !!,"End of Report. If 'Logging', please turn off 'Logging'.",! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
Q
EXPORT(PSONS,BDT,EDT,FN) ;Put in delimited format for exporting to Excel
N GUIFLAG,ROW
S GUIFLAG=1
D OENDL^PSODEARU(PSONS,BDT,EDT,FN)
Q
TYPE ;Prompt for report format or delimited list
W ! K DIR,Y S DIR(0)="SA^P:Print List;D:Delimited File"
S DIR("?",1)="Enter 'P' to see the output in a report format,"
S DIR("?")="enter 'D' for a delimited list that can be exported to excel."
S DIR("A")="Select (P)rint Report or (D)elimited File: "
D ^DIR K DIR I $D(DIRUT) S PSOOUT=1 Q
S PSOTYP=Y
Q
;
DL ;Delimited File message
;
W !!,"You have selected the delimited file output." D YN Q:$G(PSOOUT)
W @IOF
W !,"The report output will be displayed on the screen in a delimited format, so"
W !,"it can be captured and exported. If you are using Reflections, you can turn"
W !,"logging on by selecting 'Tools' on the top of the screen, then"
W !,"select 'Logging' and capture to your desired location. To avoid undesired"
W !,"wrapping, you may need to set your terminal session display settings to"
W !,"180 columns. Please enter '0;180;9999' at the 'DEVICE:' prompt. Lines"
W !,"may need to be deleted at the top and bottom of the logged file before"
W !,"importing."
W !!,"The format of the output is as follows, using '|' as the delimiter:"
W !,"Division|Provider Name|Edited by Name|Field Name|Original Data|Edited Data"
W !,"|Source File|Date Edited|DEA Number"
D YN
Q
;
YN ;yes or no prompt if no audited fields found for a file
W ! K DIR,Y,PSOOUT S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
I $D(DTOUT)!($D(DUOUT))!('Y) S PSOOUT=1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODEARU 4574 printed Sep 23, 2025@20:02:57 Page 2
PSODEARU ;WILM/BDB - EPCS Utilities and Reports; [5/7/02 5:53am] ;10/5/21 14:50
+1 ;;7.0;OUTPATIENT PHARMACY;**667,545,731**;DEC 1997;Build 18
+2 ;External reference to DEA NUMBERS file (#8991.9) is supported by DBIA 7002
+3 ;External reference to XUEPCS DATA file (#8991.6) is supported by DBIA 7015
+4 ;External reference to XUEPCS PSDRPH AUDIT file (#8991.7) is supported by DBIA 7016
+5 ;External reference to KEYS sub-file (#200.051) is supported by DBIA 7054
+6 ;
+7 QUIT
+8 ;
OENDL(PSONS,BDT,EDT,FN) ;
+1 IF '+$GET(GUIFLAG)
KILL IOP,%ZIS
SET PSOION=ION
SET %ZIS="M"
DO ^%ZIS
IF POP
SET IOP=PSOION
DO ^%ZIS
QUIT
+2 NEW PAGE,LINE,LEN,XTV,ARR,I,J,RHD,HCL,FSP,RDT,DV,DVS,FE
+3 NEW HEADER,DIVDA,PSODIV,START,DA,DATA,IEN
KILL DIRUT
+4 NEW PROVNAME,EDITOR,FLDNAME,OLDVAL,NEWVAL,EDITDATE,DEA,SRCFILE
+5 KILL ^XTMP(PSONS,$JOB),^TMP($JOB,"EPCSRPT")
+6 SET LD=BDT
FOR
SET LD=$ORDER(^XTV(FN,"DT",LD))
if 'LD!(LD>EDT)
QUIT
Begin DoDot:1
+7 SET ND=0
FOR
SET ND=$ORDER(^XTV(FN,"DT",LD,ND))
if 'ND
QUIT
Begin DoDot:2
+8 if '$DATA(^XTV(FN,ND,0))
QUIT
+9 SET DAT=^XTV(FN,ND,0)
+10 ;P731 detox/x-waiver removal
IF FN=8991.6
IF $PIECE(DAT,"^",3)=.03
QUIT
+11 SET IEN=$PIECE(DAT,"^")
+12 SET (DV,DVS)=0
FOR
SET DV=$ORDER(^VA(200,IEN,2,DV))
if ('DV)&(DVS>0)
QUIT
if 'DV
SET DV=999999
Begin DoDot:3
+13 SET DVS=DVS+1
+14 SET ^XTMP(PSONS,$JOB,DV,LD,ND)=""
End DoDot:3
End DoDot:2
End DoDot:1
+15 IF '$DATA(^XTMP(PSONS,$JOB))
Begin DoDot:1
+16 USE IO
WRITE !," *************** NO MATCHING DATA ***************",!!
End DoDot:1
QUIT
+17 SET HEADER="Division^Provider Name^Edited by Name^Field Name^Original Data^Edited Data^Source File^Date Edited^DEA Number"
+18 IF +$GET(GUIFLAG)
SET ROW=1
SET ^TMP($JOB,"EPCSRPT",ROW)=HEADER
+19 IF '+$GET(GUIFLAG)
USE IO
WRITE !,$TRANSLATE(HEADER,"^","|")
+20 SET DIVDA=""
FOR
SET DIVDA=$ORDER(^XTMP(PSONS,$JOB,DIVDA))
if 'DIVDA
QUIT
Begin DoDot:1
+21 SET PSODIV=$SELECT(DIVDA=999999:"NO DIVISION",1:$$GET1^DIQ(4,DIVDA,.01))
+22 SET START=0
FOR
SET START=$ORDER(^XTMP(PSONS,$JOB,DIVDA,START))
if 'START
QUIT
Begin DoDot:2
+23 SET DA=0
FOR
SET DA=$ORDER(^XTMP(PSONS,$JOB,DIVDA,START,DA))
if 'DA
QUIT
Begin DoDot:3
+24 SET DATA=^XTV(FN,DA,0)
SET IEN=$PIECE(DATA,"^")
SET FE=$PIECE(DATA,"^",3)
+25 DO GETS^DIQ(FN,DA,".01;.02;.03;.04;.05;.06;.08","E","XTV")
+26 SET PROVNAME=$GET(XTV(FN,DA_",",.01,"E"))
+27 SET EDITOR=$GET(XTV(FN,DA_",",.02,"E"))
+28 SET FLDNAME=$PIECE($GET(^DD($SELECT(FE>50:200,1:8991.9),FE,0)),U)
+29 IF FE=.04
Begin DoDot:4
+30 SET Y=$PIECE(DATA,"^",4)
XECUTE ^DD("DD")
SET OLDVAL=Y
+31 SET Y=$PIECE(DATA,"^",5)
XECUTE ^DD("DD")
SET NEWVAL=Y
End DoDot:4
+32 IF FE'=.04
Begin DoDot:4
+33 SET OLDVAL=$SELECT($GET(XTV(FN,DA_",",.04,"E"))="True":1,$GET(XTV(FN,DA_",",.04,"E"))="False":0,1:$GET(XTV(FN,DA_",",.04,"E")))
+34 SET NEWVAL=$SELECT($GET(XTV(FN,DA_",",.05,"E"))="True":1,$GET(XTV(FN,DA_",",.05,"E"))="False":0,1:$GET(XTV(FN,DA_",",.05,"E")))
End DoDot:4
+35 SET SRCFILE=$SELECT(FE>50:200,1:8991.9)
+36 SET Y=$PIECE($PIECE(DATA,"^",6),".",1)
XECUTE ^DD("DD")
SET EDITDATE=Y
+37 SET DEA=$PIECE(DATA,"^",8)
+38 SET RECORD=PSODIV_U_PROVNAME_U_EDITOR_U_FLDNAME_U_OLDVAL_U_NEWVAL_U_SRCFILE_U_EDITDATE_U_DEA
+39 IF +$GET(GUIFLAG)
SET ROW=ROW+1
SET ^TMP($JOB,"EPCSRPT",ROW)=RECORD
+40 IF '+$GET(GUIFLAG)
WRITE !,$TRANSLATE(RECORD,"^","|")
End DoDot:3
if $DATA(DIRUT)
QUIT
End DoDot:2
if $DATA(DIRUT)
QUIT
End DoDot:1
+41 IF '+$GET(GUIFLAG)
WRITE !!,"End of Report. If 'Logging', please turn off 'Logging'.",!
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
+42 QUIT
EXPORT(PSONS,BDT,EDT,FN) ;Put in delimited format for exporting to Excel
+1 NEW GUIFLAG,ROW
+2 SET GUIFLAG=1
+3 DO OENDL^PSODEARU(PSONS,BDT,EDT,FN)
+4 QUIT
TYPE ;Prompt for report format or delimited list
+1 WRITE !
KILL DIR,Y
SET DIR(0)="SA^P:Print List;D:Delimited File"
+2 SET DIR("?",1)="Enter 'P' to see the output in a report format,"
+3 SET DIR("?")="enter 'D' for a delimited list that can be exported to excel."
+4 SET DIR("A")="Select (P)rint Report or (D)elimited File: "
+5 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET PSOOUT=1
QUIT
+6 SET PSOTYP=Y
+7 QUIT
+8 ;
DL ;Delimited File message
+1 ;
+2 WRITE !!,"You have selected the delimited file output."
DO YN
if $GET(PSOOUT)
QUIT
+3 WRITE @IOF
+4 WRITE !,"The report output will be displayed on the screen in a delimited format, so"
+5 WRITE !,"it can be captured and exported. If you are using Reflections, you can turn"
+6 WRITE !,"logging on by selecting 'Tools' on the top of the screen, then"
+7 WRITE !,"select 'Logging' and capture to your desired location. To avoid undesired"
+8 WRITE !,"wrapping, you may need to set your terminal session display settings to"
+9 WRITE !,"180 columns. Please enter '0;180;9999' at the 'DEVICE:' prompt. Lines"
+10 WRITE !,"may need to be deleted at the top and bottom of the logged file before"
+11 WRITE !,"importing."
+12 WRITE !!,"The format of the output is as follows, using '|' as the delimiter:"
+13 WRITE !,"Division|Provider Name|Edited by Name|Field Name|Original Data|Edited Data"
+14 WRITE !,"|Source File|Date Edited|DEA Number"
+15 DO YN
+16 QUIT
+17 ;
YN ;yes or no prompt if no audited fields found for a file
+1 WRITE !
KILL DIR,Y,PSOOUT
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
+2 IF $DATA(DTOUT)!($DATA(DUOUT))!('Y)
SET PSOOUT=1
+3 QUIT
+4 ;
