Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSODEARX

PSODEARX.m

Go to the documentation of this file. 
  1. PSODEARX ;WILM/BDB - EPCS Utilities and Reports; [5/7/02 5:53am] ;3/3/22  14:50
  1.  ;;7.0;OUTPATIENT PHARMACY;**545,731**;DEC 1997;Build 18
  1.  ;External reference to DEA NUMBERS file (#8991.9) is supported by DBIA 7002
  1.  ;
  1.  Q
  1.  ;
  1. DL ;Delimited File message
  1.  ;
  1.  W !!,"You have selected the delimited file output." D YN Q:$G(PSOOUT)
  1.  W @IOF
  1.  W !,"The report output will be displayed on the screen in a delimited format, so"
  1.  W !,"it can be captured and exported.  If you are using Reflections, you can turn"
  1.  W !,"logging on by selecting 'Tools' on the top of the screen, then"
  1.  W !,"select 'Logging' and capture to your desired location.  To avoid undesired"
  1.  W !,"wrapping, you may need to set your terminal session display settings to"
  1.  W !,"132 columns.  Please enter '0;132;9999' at the 'DEVICE:' prompt.  Lines"
  1.  W !,"may need to be deleted at the top and bottom of the logged file before"
  1.  W !,"importing."
  1.  W !!,"The format of the output is as follows, using '|' as the delimiter:"
  1.  W !,"Name|IEN|DEA(#200)|Error Text"
  1.  D YN
  1.  Q
  1.  ;
  1. YN ;yes or no prompt if no audited fields found for a file
  1.  W ! K DIR,Y,PSOOUT S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR
  1.  I $D(DTOUT)!($D(DUOUT))!('Y) S PSOOUT=1
  1.  K DIRUT,DTOUT,DUOUT,DIR,X,Y
  1.  Q
  1.  ;
  1. RUN(PSHEADER)  ; Run Report
  1.  N PSCOUNT2,PSOTD,PSONAME,POP,IOP,PSOION
  1.  S PSOION=ION,%ZIS="M" D ^%ZIS I POP S IOP=PSOION D ^%ZIS Q
  1.  K ^TMP($J,"PSODEARW") ; Clear the temporary accumulator
  1.  D COMPILE
  1.  U IO
  1.  W "Name","|","IEN","|","DEA","|","Error Text"
  1.  W "     Run Date: ",$$FMTE^XLFDT(DT,"5DZ")
  1.  I '$D(^TMP($J,"PSODEARW")) W "There is no Data to Print",!
  1.  S PSCOUNT2=0 F  S PSCOUNT2=$O(^TMP($J,"PSODEARW",PSCOUNT2)) Q:+PSCOUNT2=0  Q:PSOQ  D
  1.  . W !,^TMP($J,"PSODEARW",PSCOUNT2,1),"|"
  1.  D ^%ZISC
  1.  K ^TMP($J,"PSODEARW") ; Clear the temporary accumulator
  1.  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
  1.  Q
  1.  ;
  1. COMPILE  ; -- Compile the report lines into the sort global
  1.  N NAME,NPIEN,NPDEAIEN,ERROR,PRVNAME,NPDEA,DNDEA,PSOLINE,PSCOUNT1,NXNPIEN,NXDEAIEN
  1.  N DNDETOX,NXDEA,DETOXCT,DNINPT,DNINPTCT,INDIV,DNDEAIEN,DNDEASX,DNDEATYP
  1.  S ERROR(1)="MISSING DEA NUMBER IN (#8991.9)"
  1.  S ERROR(2)="PROVIDER NAME MISMATCH (#200)(#8991.9)"
  1.  S ERROR(3)="INSTITUTIONAL DEA MISSING SUFFIX"
  1.  S ERROR(4)="DEA ASSIGNED TO PROVIDER:"
  1.  S ERROR(5)="DUPLICATE DETOX NUMBER"
  1.  S ERROR(6)="PROVIDER WITH MULTIPLE DETOX NUMBERS"
  1.  S ERROR(7)="PROVIDER MISSING DEA INPATIENT FLAG"
  1.  S PSCOUNT1=0
  1.  S NAME="" F  S NAME=$O(^VA(200,"B",NAME)) Q:NAME=""  D
  1.  . S NPIEN=0 F  S NPIEN=$O(^VA(200,"B",NAME,NPIEN)) Q:'NPIEN  D
  1.  . . Q:'$D(^VA(200,NPIEN,"PS4"))
  1.  . . I '$O(^VA(200,NPIEN,"PS4",0)) Q
  1.  . . S PRVNAME=$$GET1^DIQ(200,NPIEN,.01,"E")
  1.  . . ;P731 detox/x-waiver removal
  1.  . . ;CHECK FOR PROVIDER WITH MULTIPLE DETOX NUMBERS ERROR 6
  1.  . . ;S DETOXCT=0,NPDEAIEN=0 F  S NPDEAIEN=$O(^VA(200,NPIEN,"PS4",NPDEAIEN)) Q:'NPDEAIEN  D  I DETOXCT>1 Q
  1.  . . ;. S NPDEA=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.01,"E")
  1.  . . ;. S DNDEAIEN=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.03,"I")
  1.  . . ;. S DNDETOX=$$GET1^DIQ(8991.9,DNDEAIEN,.03) I DNDETOX]"" S DETOXCT=DETOXCT+1
  1.  . . ;. I DETOXCT>1 D
  1.  . . ;. . S PSOLINE="",NPDEA=""
  1.  . . ;. . S PSOLINE=PSOLINE_PRVNAME_"|"                     ; NAME            #200,    #.01
  1.  . . ;. . S PSOLINE=PSOLINE_NPIEN_"|"                        ; IEN             #200
  1.  . . ;. . S PSOLINE=PSOLINE_NPDEA_"|"                        ; NEW DEA NUMBER  #200,   
  1.  . . ;. . S PSOLINE=PSOLINE_ERROR(6)   ; ERROR TEXT
  1.  . . ;. . S PSCOUNT1=PSCOUNT1+1
  1.  . . ;. . S ^TMP($J,"PSODEARW",PSCOUNT1,1)=PSOLINE
  1.  . . ;CHECK FOR PROVIDER WITH ALL INDIVIDUAL DEA MISSING DEA INPATIENT FLAG ERROR 7
  1.  . . S INDIV=0,DNINPTCT=0,NPDEAIEN=0 F  S NPDEAIEN=$O(^VA(200,NPIEN,"PS4",NPDEAIEN)) Q:'NPDEAIEN  D  I DNINPTCT>0 Q
  1.  . . . S NPDEA=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.01,"E")
  1.  . . . S DNDEAIEN=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.03,"I") Q:DNDEAIEN=""
  1.  . . . S DNDEATYP=$$GET1^DIQ(8991.9,DNDEAIEN,.07,"E") I DNDEATYP="INDIVIDUAL" S INDIV=1 D
  1.  . . . . S DNINPT=$$GET1^DIQ(8991.9,DNDEAIEN,.06) I DNINPT="YES" S DNINPTCT=DNINPTCT+1
  1.  . . I INDIV>0,DNINPTCT=0 D
  1.  . . . S PSOLINE="",NPDEA=""
  1.  . . . S PSOLINE=PSOLINE_PRVNAME_"|"                     ; NAME            #200,    #.01
  1.  . . . S PSOLINE=PSOLINE_NPIEN_"|"                        ; IEN             #200
  1.  . . . S PSOLINE=PSOLINE_NPDEA_"|"                        ; NEW DEA NUMBER  #200,   
  1.  . . . S PSOLINE=PSOLINE_ERROR(7)   ; ERROR TEXT
  1.  . . . S PSCOUNT1=PSCOUNT1+1
  1.  . . . S ^TMP($J,"PSODEARW",PSCOUNT1,1)=PSOLINE
  1.  . . ;CHECK EACH PROVIDER DEA
  1.  . . S NPDEAIEN=0 F  S NPDEAIEN=$O(^VA(200,NPIEN,"PS4",NPDEAIEN)) Q:'NPDEAIEN  D  I DNDEA']"" Q
  1.  . . . ; CHECK FOR MISSING DEA NUMBER (FILE: #8991.9) ERROR 1
  1.  . . . S NPDEA=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.01,"E")
  1.  . . . S DNDEA=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.03,"E")
  1.  . . . S DNDEAIEN=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.03,"I")
  1.  . . . I (DNDEA']"")!(NPDEA'=DNDEA) D
  1.  . . . . S PSOLINE=""
  1.  . . . . S PSOLINE=PSOLINE_PRVNAME_"|"                     ; NAME            #200,    #.01
  1.  . . . . S PSOLINE=PSOLINE_NPIEN_"|"                        ; IEN             #200
  1.  . . . . S PSOLINE=PSOLINE_NPDEA_"|"                        ; NEW DEA NUMBER  #200,
  1.  . . . . S PSOLINE=PSOLINE_ERROR(1)                         ; ERROR TEXT
  1.  . . . . S PSCOUNT1=PSCOUNT1+1
  1.  . . . . S ^TMP($J,"PSODEARW",PSCOUNT1,1)=PSOLINE
  1.  . . . ;CHECK FOR PROVIDER NAME MISMATCH (#200)(#8991.9) ERROR 2
  1.  . . . I (DNDEA]"")&($P(PRVNAME,",",1)'=$P($$GET1^DIQ(8991.9,DNDEAIEN,1.1),",",1)) D
  1.  . . . . S PSOLINE=""
  1.  . . . . S PSOLINE=PSOLINE_PRVNAME_"|"                     ; NAME            #200,    #.01
  1.  . . . . S PSOLINE=PSOLINE_NPIEN_"|"                        ; IEN             #200
  1.  . . . . S PSOLINE=PSOLINE_NPDEA_"|"                        ; NEW DEA NUMBER  #200,   
  1.  . . . . S PSOLINE=PSOLINE_ERROR(2)                         ; ERROR TEXT
  1.  . . . . S PSCOUNT1=PSCOUNT1+1
  1.  . . . . S ^TMP($J,"PSODEARW",PSCOUNT1,1)=PSOLINE
  1.  . . . ;CHECK FOR INSTITUTIONAL DEA MISSING SUFFIX ERROR 3
  1.  . . . S DNDEAIEN=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.03,"I")
  1.  . . . S DNDEATYP=$$GET1^DIQ(8991.9,DNDEAIEN,.07,"E")
  1.  . . . S DNDEASX=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.02,"E")
  1.  . . . I (DNDEATYP="INSTITUTIONAL")&(DNDEASX="") D  Q
  1.  . . . . S PSOLINE=""
  1.  . . . . S PSOLINE=PSOLINE_PRVNAME_"|"                     ; NAME            #200,    #.01
  1.  . . . . S PSOLINE=PSOLINE_NPIEN_"|"                        ; IEN             #200
  1.  . . . . S PSOLINE=PSOLINE_NPDEA_"|"                        ; NEW DEA NUMBER  #200,   
  1.  . . . . S PSOLINE=PSOLINE_ERROR(3)                         ; ERROR TEXT
  1.  . . . . S PSCOUNT1=PSCOUNT1+1
  1.  . . . . S ^TMP($J,"PSODEARW",PSCOUNT1,1)=PSOLINE
  1.  . . . ;CHECK FOR DEA ASSIGNED TO PROVIDER: ERROR 4
  1.  . . . I DNDEATYP="INDIVIDUAL" S NXNPIEN="" F  S NXNPIEN=$O(^VA(200,"PS4",NPDEA,NXNPIEN)) Q:NXNPIEN=""  I NXNPIEN'=NPIEN D  Q
  1.  . . . . S PSOLINE=""
  1.  . . . . S PSOLINE=PSOLINE_PRVNAME_"|"                     ; NAME            #200,    #.01
  1.  . . . . S PSOLINE=PSOLINE_NPIEN_"|"                        ; IEN             #200
  1.  . . . . S PSOLINE=PSOLINE_NPDEA_"|"                        ; NEW DEA NUMBER  #200,   
  1.  . . . . S PSOLINE=PSOLINE_ERROR(4)_"  "_$$GET1^DIQ(200,NXNPIEN_",",.01)   ; ERROR TEXT
  1.  . . . . S PSCOUNT1=PSCOUNT1+1
  1.  . . . . S ^TMP($J,"PSODEARW",PSCOUNT1,1)=PSOLINE
  1.  . . . ;CHECK FOR DUPLICATE DETOX NUMBER
  1.  . . . ;P731 detox/x-waiver removal
  1.  . . . ;S DNDETOX=$$GET1^DIQ(8991.9,DNDEAIEN,.03)
  1.  . . . ;I DNDETOX]"" S NXDEA="" F  S NXDEA=$O(^XTV(8991.9,"D",DNDETOX,NXDEA)) Q:NXDEA=""  I NXDEA'=NPDEA D  Q
  1.  . . . ;. S NXDEAIEN=$O(^XTV(8991.9,"D",DNDETOX,NXDEA,""))
  1.  . . . ;. S PSOLINE=""
  1.  . . . ;. S PSOLINE=PSOLINE_PRVNAME_"|"                     ; NAME            #200,    #.01
  1.  . . . ;. S PSOLINE=PSOLINE_NPIEN_"|"                        ; IEN             #200
  1.  . . . ;. S PSOLINE=PSOLINE_NPDEA_"|"                        ; NEW DEA NUMBER  #200,   
  1.  . . . ;. S PSOLINE=PSOLINE_ERROR(5)_"  DEA:"_$$GET1^DIQ(8991.9,NXDEAIEN_",",.01)   ; ERROR TEXT
  1.  . . . ;. S PSCOUNT1=PSCOUNT1+1
  1.  . . . ;. S ^TMP($J,"PSODEARW",PSCOUNT1,1)=PSOLINE
  1.  Q
  1.  ;