- 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 Feb 18, 2025@23:53:08 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 ;
