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

XUSNPIE2.m

Go to the documentation of this file.
  1. XUSNPIE2 ;FO-OAKLAND/JLI - DATA ENTRY FOR INITIAL NPI VALUES ; Dec 16, 2021@08:24:28
  1. ;;8.0;KERNEL;**410,435,454,462,480,519,752,764**;Jul 10, 1995;Build 1
  1. ;;Per VHA Directive 2004-038, this routine should not be modified
  1. Q
  1. ;
  1. PRINTOPT ;
  1. N DIR,%ZIS,ION,OPTION,PRNTFRMT,XUSDIV,XUSSORT,XUSRESO,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,XUSER
  1. K IO("Q")
  1. W !,"Select one of the following:",!!,?11,"1",?21,"All providers",!,?11,"2",?21,"All providers without NPI numbers",!
  1. S DIR(0)="N^1:2",DIR("A")="Select a report option",DIR("B")="1" D ^DIR K DIR Q:Y'>0 S OPTION=+Y
  1. S XUSRESO="" D Q:XUSRESO=""
  1. . S DIR(0)="S^P:Providers who are not residents;R:Residents only;B:Both"
  1. . S DIR("B")="P",DIR("A")="Selection: "
  1. . D ^DIR K DIR Q:"PRB"'[Y
  1. . S XUSRESO=Y Q
  1. ; Change of XU*8*519 #1 (add 3 lines of code below)
  1. W !!,"Select one of the following:",!!,?11,"1",?21,"ACTIVE users only",!,?11,"2",?21,"ACTIVE and DISUSERed users",!
  1. S DIR(0)="N^1:2",DIR("A")="Select a report option",DIR("B")="1" D ^DIR K DIR Q:Y'>0 S XUSER=+Y
  1. ; End XU*8*519 #1
  1. ;
  1. S DIR(0)="Y",DIR("B")="NO",DIR("A")="Sort by DIVISION" D ^DIR K DIR Q:Y="^" S XUSDIV=+Y
  1. S PRNTFRMT=1
  1. I XUSDIV S DIR(0)="N^1:2",DIR("A")="Output type (1=Printed text or 2=^-delimited)" D ^DIR K DIR Q:Y'>0 S PRNTFRMT=Y
  1. S DIR(0)="Y",DIR("B")="YES",DIR("A")="Sort by SERVICE/SECTION"_$S(XUSDIV>0:" (as well)",1:"") D ^DIR K DIR Q:Y="^" S XUSSORT=+Y
  1. W !!,">>> Report processing time is approximately 10 minutes."
  1. W !," Recommend text output be queued to a network printer."
  1. W !
  1. S %ZIS="MQ" D ^%ZIS Q:POP
  1. I $D(IO("Q")) D Q
  1. . S ZTSAVE("OPTION")="",ZTSAVE("XUSSORT")="",ZTSAVE("XUSDIV")="",ZTSAVE("PRNTFRMT")="",ZTSAVE("XUSRESO")="",ZTSAVE("XUSER")=""
  1. . S ZTIO=ION,ZTRTN="DQ^XUSNPIE2",ZTDESC="NPI PRINT JOB FOR OPTION "_OPTION
  1. . D ^%ZTLOAD W:$D(ZTSK) !,"Queued as Task "_ZTSK D HOME^%ZIS Q
  1. ;
  1. DQ ; entry point for queued print job
  1. U IO D PRNTPROV(OPTION,XUSSORT,XUSDIV,PRNTFRMT,XUSRESO,XUSER)
  1. U IO D ^%ZISC
  1. Q
  1. ;
  1. PRNTPROV(OPTION,XUSSORT,XUSDIV,PRNTFRMT,XUSRESO,XUSER) ;
  1. ; PRINT PROVIDER INFO
  1. ;
  1. ; OPTION SPECIFIES TYPE OF PRINT - 1=ALL PROVIDERS, 2=NEEDS NPI ONLY
  1. ; XUSSORT INDICATES WHETHER SORTED BY SERVICE/SECTION
  1. ; XUSDIV INDICATES WHETHER SORTED BY DIVISION
  1. ; PRNTFRMT INDICATES TYPE OF OUTPUT, PRINTED OR ^-DELIMITED
  1. ;
  1. ; ZEXCEPT: IOSL - KERNEL VARIABLE
  1. S XUSER=$G(XUSER) ;add p 519
  1. N PAGENUM,LINENUM,PROVNAME,TAXDESCR,TAXONOMY,SERVSECT,DIRUT,DTOUT
  1. N GLOBLOC,IEN,NPI,DATETIME,GLOBVALU,NCOUNT,GLOBLOC1,XUSDIVNM,CNTTOTAL,CNTNONE,CNTEXMPT,CNTDONE,MULTDIV,MULTDIVC,XUSDIS
  1. S CNTTOTAL=0,CNTNONE=0,CNTEXMPT=0,CNTDONE=0,XUSDIS=""
  1. S PAGENUM=0,LINENUM=0
  1. S DATETIME=$$NOW^XLFDT()
  1. S XUSNPIBA="XUSNPIPRNT"
  1. S GLOBLOC1=$$GETDATA(OPTION,XUSSORT,XUSDIV,XUSRESO,XUSER)
  1. I PRNTFRMT'=1 W !,"PROVIDER_NAME^LAST4^IEN^NPI^TAXONOMY_CODE^TAXONOMY DESCRIPTION"_$S(XUSDIV:"^DIVISION",1:"")_$S(XUSSORT:"^SERVICE/SECTION",1:"")
  1. S GLOBLOC=GLOBLOC1,XUSDIVNM="" F S XUSDIVNM=$O(@GLOBLOC1@(XUSDIVNM)) Q:XUSDIVNM="" D Q:$D(DIRUT)!$D(DTOUT)
  1. . S SERVSECT="" F S SERVSECT=$O(@GLOBLOC1@(XUSDIVNM,SERVSECT)) Q:SERVSECT="" S GLOBLOC=$NA(@GLOBLOC1@(XUSDIVNM,SERVSECT)) D Q:$D(DIRUT)!$D(DTOUT)
  1. . . I PRNTFRMT=1 D HEADER(OPTION,DATETIME,.PAGENUM,.LINENUM,XUSDIV,XUSDIVNM,XUSSORT,SERVSECT,XUSRESO,XUSER) Q:$D(DIRUT)!$D(DTOUT)
  1. . . S PROVNAME="" F S PROVNAME=$O(@GLOBLOC@(PROVNAME)) Q:PROVNAME="" Q:$D(DIRUT)!$D(DTOUT) S IEN=0 F S IEN=$O(@GLOBLOC@(PROVNAME,IEN)) Q:IEN'>0 D Q:$D(DIRUT)!$D(DTOUT)
  1. . . . S NCOUNT=0
  1. . . . S TAXDESCR="" F S TAXDESCR=$O(@GLOBLOC@(PROVNAME,IEN,TAXDESCR)) Q:TAXDESCR="" S GLOBVALU=@GLOBLOC@(PROVNAME,IEN,TAXDESCR) D
  1. . . . . S NPI=$P(GLOBVALU,U,3),TAXONOMY=$P(GLOBVALU,U,4),XUSDIS=$P(GLOBVALU,U,6)
  1. . . . . I PRNTFRMT=1 S NCOUNT=NCOUNT+1 W:NCOUNT=1 !,PROVNAME,?33,$$ALIGNRGT(IEN,11),?49,NPI,?65,XUSDIS W !,?6,TAXONOMY," ",TAXDESCR
  1. . . . . I PRNTFRMT'=1 W !,PROVNAME_U_$E($$GET1^DIQ(200,IEN_",",9),6,9)_U_IEN_U_NPI_U_TAXONOMY_U_TAXDESCR_$S(XUSDIV:U_XUSDIVNM,1:"")_$S(XUSSORT:U_SERVSECT,1:"")
  1. . . . . Q
  1. . . . I PRNTFRMT=1 S LINENUM=LINENUM+NCOUNT+1 I LINENUM>(IOSL-4) D HEADER(OPTION,DATETIME,.PAGENUM,.LINENUM,XUSDIV,XUSDIVNM,XUSSORT,SERVSECT,XUSRESO,XUSER) Q:$D(DIRUT)!$D(DTOUT)
  1. . . . Q
  1. . . Q
  1. . Q
  1. I '($D(DIRUT)!$D(DTOUT)),PRNTFRMT=1 D
  1. . S PROVNAME="" I $O(@GLOBLOC@(PROVNAME))="" W !,?20,"* * * N O D A T A F O U N D * * *",!! I 1
  1. . E D
  1. . . N TOTTYP S TOTTYP=$S(XUSRESO="R":"Residents",1:"Billable Providers")
  1. . . W !!,"Total "_TOTTYP_":",?43,CNTTOTAL,!,TOTTYP_" with an NPI:",?43,CNTDONE,!,"EXEMPT "_TOTTYP_":",?43,CNTEXMPT,!,TOTTYP_" Still Needing an NPI:",?43,CNTNONE
  1. . . I $G(MULTDIV)>0 W !!,MULTDIV," Providers were repeated a total of ",MULTDIVC," times",!," due to listing under multiple divisions"
  1. . . Q
  1. . W !!,?27,"*** End of Report ***"
  1. . Q
  1. Q
  1. ;
  1. ; ZEXCEPT: IOF,IOST KERNEL IO VARIABLES
  1. ; ZEXCEPT: DIRUT,DTOUT NEWED IN CALLING PRNTPROV - INDICATE QUIT TO PRNTPROV
  1. N TEMPVAL,DIR,X,Y
  1. S PAGNOREF=PAGNOREF+1
  1. S XUSER=$G(XUSER) ; add p 519
  1. ; Don't page feed on the first page
  1. IF PAGNOREF>1 I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR I 'Y S DIRUT=1 Q
  1. IF PAGNOREF>1 W @IOF
  1. W:$E(IOST,1,2)'="C-" !
  1. W "Active Provider Report ("_$S(XUSRESO="P":"no residents)",XUSRESO="R":"residents only)",1:"includes residents)")
  1. W ?48,$$FMTE^XLFDT(DATETIME)," Page: ",PAGNOREF
  1. W !,"Report Option: Provider List Active ",$S(XUSER=2:"and Disuser ",1:""),"Providers",$S(OPTION=2:" Without NPI Numbers",1:"")
  1. W !!,"Provider Name",?39,"IEN",?49,$S(OPTION'=2:"NPI",1:""),?65,$S(XUSER=2:"Disuser",1:"")
  1. W !," Taxonomy"
  1. W !,"--------------------------------------------------------------------------------"
  1. S LINNOREF=6
  1. I XUSDIV W !,"DIVISION: ",XUSDIVNM," " S LINNOREF=LINNOREF+1
  1. I XUSSORT W:'XUSDIV ! W "SERVICE/SECTION: ",SERVSECT S:'XUSDIV LINNOREF=LINNOREF+1
  1. Q
  1. ;
  1. GETDATA(OPTION,XUSSORT,XUSDIV,XUSRESO,XUSER) ; get data for reports for providers
  1. N NPI,PROVNAME,TAXDESCR,TAXONOMY,XUSDEFLT,XUSDIVCN,XUSDIVN,XUSDIVNM,XUSGLOB,XUSACTV,XUSSKIP
  1. N XUSIEN,XUSSERVC,XUSVAL,CNTCLEAN,X,XUSDIS
  1. S XUSRESO=$G(XUSRESO)
  1. S XUSER=$G(XUSER) I XUSER="" S XUSER=1 ;add p 519 - active users only reported
  1. S XUSDIS="" ; p 519
  1. ; ZEXCEPT: CNTTOTAL,CNTNONE,CNTEXMPT,CNTDONE - NEWed and initialized in PRNTPROV or killed based on CNTCLEAN
  1. S CNTCLEAN=0 I '$D(CNTTOTAL) S CNTCLEAN=1
  1. S XUSGLOB=$NA(^TMP($J,"XUSNPIPRNT")) K @XUSGLOB
  1. I 'XUSDIV S XUSDIVNM(1)=" ",XUSDEFLT=" "
  1. I XUSDIV S XUSDEFLT=$$NS^XUAF4($$KSP^XUPARAM("INST")),XUSDEFLT=$P(XUSDEFLT,U)
  1. I 'XUSSORT S XUSSERVC=" "
  1. N XUS1,XUS2
  1. F XUSIEN=0:0 S XUSIEN=$O(^VA(200,XUSIEN)) Q:(XUSIEN'>0)!(XUSIEN'=+XUSIEN) D
  1. . ; Don't report TERMINATED
  1. . S XUSACTV=$$ACTIVE^XUSER(XUSIEN)
  1. . I XUSACTV=""!($P(XUSACTV,U,2)="TERMINATED") Q ;p 519
  1. . I XUSER=1,$P(XUSACTV,U)=0 Q ;p 519
  1. . S XUSDIS="" I $P(XUSACTV,U,2)="DISUSER" S XUSDIS="Yes" ;p 519
  1. . ; Don't report users with null NPI ENTRY STATUS
  1. . S XUSVAL=$$CHEKNPI^XUSNPIED(XUSIEN),XUSVAL=$$NPISTATS^XUSNPIED(XUSIEN)
  1. . I $$GETNPI^XUSNPIED(XUSIEN)>0 S $P(^VA(200,XUSIEN,"NPI"),"^",2)="D",XUSVAL=$$NPISTATS^XUSNPIED(XUSIEN) ; p764
  1. . Q:XUSVAL=""
  1. . S PROVNAME=$$GET1^DIQ(200,XUSIEN_",",.01),NPI=$$GETNPI^XUSNPIED(XUSIEN),TAXONOMY=$$GETTAXON^XUSNPIED(XUSIEN,.TAXDESCR) I TAXONOMY=-1 S TAXONOMY=" ",TAXDESCR=" "
  1. . ; Determine whether provider is a resident for local reports.
  1. . I OPTION'=3,XUSRESO'="B" S XUSSKIP=0 D Q:XUSSKIP
  1. . . I XUSRESO="R",TAXONOMY'="390200000X" S XUSSKIP=1 Q
  1. . . I XUSRESO="P",TAXONOMY="390200000X" S XUSSKIP=1
  1. . . Q
  1. . I NPI="",$$EXMPTNPI^XUSNPIED(XUSIEN) S NPI="EXEMPTED "
  1. . I NPI="",XUSVAL="D" S XUSVAL="N",$P(^VA(200,XUSIEN,"NPI"),"^",2)=XUSVAL ;p752 to correct the NPI ENTRY STATUS
  1. . S CNTTOTAL=$G(CNTTOTAL)+1 S:NPI="" CNTNONE=$G(CNTNONE)+1 S:NPI="EXEMPTED " CNTEXMPT=$G(CNTEXMPT)+1 S:NPI?10N CNTDONE=$G(CNTDONE)+1
  1. . I '((XUSVAL="N")!(OPTION'=2)) Q
  1. . I XUSSORT S XUSSERVC=$$GET1^DIQ(200,XUSIEN_",",29) I XUSSERVC="" S XUSSERVC=" "
  1. . I XUSDIV D
  1. . . K XUSDIVNM S XUSDIVCN=0,XUSDIVNM(1)=XUSDEFLT
  1. . . F XUSDIVN=0:0 S XUSDIVN=$O(^VA(200,XUSIEN,2,XUSDIVN)) Q:XUSDIVN'>0 S XUSDIVCN=XUSDIVCN+1,XUSDIVNM(XUSDIVCN)=$$GET1^DIQ(200.02,XUSDIVN_","_XUSIEN_",",.01)
  1. . . I XUSDIVCN>1 S MULTDIV=$G(MULTDIV)+1,MULTDIVC=$G(MULTDIVC)+XUSDIVCN-1
  1. . . Q
  1. . F XUSDIVN=0:0 S XUSDIVN=$O(XUSDIVNM(XUSDIVN)) Q:XUSDIVN'>0 D
  1. . . S X=PROVNAME_U_XUSIEN_U_NPI_U_TAXONOMY_U_TAXDESCR I XUSDIS="Yes" S X=X_U_XUSDIS ;p 519 add piece #6 on X
  1. . . S @XUSGLOB@(XUSDIVNM(XUSDIVN),XUSSERVC,PROVNAME,XUSIEN,TAXDESCR)=X
  1. . . Q
  1. . Q
  1. I CNTCLEAN K CNTTOTAL,CNTNONE,CNTEXMPT,CNTDONE
  1. Q XUSGLOB
  1. ;
  1. ALIGNRGT(TEXT,WIDTH) ; align text right in a specified width
  1. N RESULT
  1. S $P(RESULT," ",WIDTH)=" ",RESULT=RESULT_TEXT,RESULT=$E(RESULT,$L(RESULT)-WIDTH+1,$L(RESULT))
  1. Q RESULT
  1. ;
  1. CHKOLD1(IEN) ; check for earlier value, and activate if present
  1. N IEN1,STATUS,NPI,DATE,XUFDA
  1. S IEN1=$O(^VA(200,IEN,"NPISTATUS"," "),-1) I IEN1>0 D I STATUS=0 D CHKOLD1(IEN)
  1. . S STATUS=^VA(200,IEN,"NPISTATUS",IEN1,0),NPI=$P(STATUS,U,3),DATE=$P(STATUS,U),STATUS=$P(STATUS,U,2)
  1. . I STATUS=0 D DELETNPI(IEN,IEN1,DATE) Q ; entry making it INACTIVE - remove it
  1. . I STATUS=1 D SET^XUSNPIE1(IEN,NPI)
  1. . Q
  1. Q
  1. ;
  1. DELETNPI(IEN,OIEN,ODATEVAL) ;
  1. N XUFDA
  1. I $D(ODATEVAL) S XUFDA(200.042,OIEN_","_IEN_",",.01)="@" D FILE^DIE("","XUFDA")
  1. I $O(^VA(200,IEN,"NPISTATUS",0))>0 Q
  1. N XUFDA
  1. I $$GET1^DIQ(200,IEN_",",41.99) S XUFDA(200,IEN_",",41.99)="@"
  1. I $$GET1^DIQ(200,IEN_",",41.98)'="" S XUFDA(200,IEN_",",41.98)="@"
  1. I $D(XUFDA) D FILE^DIE("","XUFDA")
  1. Q
  1. ;
  1. CLERXMPT ; edit entry indicating whether a provider is exempt from needing an NPI
  1. N DIC,DIR,FDA,IEN,Y
  1. W ! S DIC="^VA(200,",DIC(0)="AEQ" S DIC("A")="select Provider: " D ^DIC Q:Y'>0 S IEN=+Y
  1. I $$HASNPI^XUSNPIED(IEN) W !,"This Provider already has an NPI value. Nothing to do." Q
  1. I '$$CHEKNPI^XUSNPIED(IEN),'$$EXMPTNPI^XUSNPIED(IEN) W !,"This Provider does not appear to need an NPI or Exemption." Q
  1. I $$EXMPTNPI^XUSNPIED(IEN) D Q ; currently marked as Exempt
  1. . S DIR(0)="Y",DIR("A")="Provider is currently EXEMPT from needing an NPI, set to NEEDS an NPI (Y/N)" D ^DIR I 'Y Q
  1. . S FDA(200,IEN_",",41.98)="N" D FILE^DIE("","FDA")
  1. . W !,$S($$NEEDSNPI^XUSNPIED(IEN):"File updated",1:"Ecountered a problem updating file, status NOT set to NEEDS an NPI")
  1. . Q
  1. ; check to make sure provider should be exempt
  1. S DIR(0)="Y",DIR("A")="Confirm that Provider should be Exempt from needing an NPI (Y/N)" D ^DIR I 'Y Q
  1. ; and update file to show as exempt
  1. S FDA(200,IEN_",",41.98)="E" D FILE^DIE("","FDA")
  1. W !,$S($$EXMPTNPI^XUSNPIED(IEN):"File updated",1:"Ecountered a problem updating file, status NOT set to EXEMPT")
  1. Q