PSONVAP4 ;HPS/DSK - NON-VA PROVIDER BACKOUT ;May 16, 2018@16:00
;;7.0;OUTPATIENT PHARMACY;**481**;DEC 1997;Build 31
;
;EXTERNAL REFERENCES
; NEW PERSON FILE - IA #10060 (Supported)
; NEW PERSON PHARMACY FIELDS - IA #6889 (Private)
; %DT - IA #10003 (Supported)
; BMES^XPDUTL - IA #10141 (Supported)
;
Q
;
EN ;
N DIR,DTOUT,DUOUT,Y,PSOQUIT,PSODT
S PSOQUIT=0
W !!,"This option is to be used ONLY to inactivate non-VA providers"
W !,"which were loaded by the Non-VA Provider Import option."
W !!,"If you proceed, NEW PERSON (#200) file entries which meet"
W !,"the following criteria:",!
W !,?2,"NON-VA PRESCRIBER (#53.91) field = YES"
W !,?2,"REMARKS (#53.9) field contains ""NON-VA PROVIDER"""
W !,?2,"DATE ENTERED (#30) field = the date specified in the ""DATE ENTERED"" prompt"
W !!,"will have:"
W !!,?2,"DISUSER (#7) field set to ""YES"""
W !!,?2,"TERMINATION DATE (#9.2) and INACTIVE DATE (#53.4)"
W !,?2,"fields populated with yesterday's date."
W !,?2,"(Yesterday's date must be used in order to immediately"
W !,?2,"inactivate the providers.)"
W !!,?2,"REMARKS (#53.9) field will have a comment added:"
W !,?2,"""INACTIVATED BY NON-VA INACTIVATE OPTION"".",!
K DIR S DIR(0)="Y",DIR("B")="NO"
S DIR("?")="Enter ""Y"" if you wish to proceed."
S DIR("A")="Do you wish to proceed"
D ^DIR K DIR
I 'Y!($D(DUOUT))!($D(DTOUT)) S PSOQUIT=1 Q
D ASK
Q:PSOQUIT
D INACT
Q
;
ASK ;
N DIR,%DT,DTOUT,DUOUT,Y
S %DT="AEPX",%DT("A")="What DATE ENTERED (#30) field value for the entries which should be inactivated? "
D ^%DT
I +Y<1!($G(DTOUT))!($G(DUOUT)) S PSOQUIT=1 Q
S PSODT=Y
D DD^%DT
W !!,"NEW PERSON (#200) file entries for non-VA providers which were entered on"
W !,Y," will be inactivated."
K DIR S DIR(0)="Y",DIR("B")="NO"
S DIR("?")="Enter ""Y"" if you wish to proceed."
S DIR("A")="Do you wish to proceed"
D ^DIR K DIR
I 'Y!($D(DUOUT))!($D(DTOUT)) S PSOQUIT=1
Q
;
INACT ;
N PSOIEN,PSOFDA,PSOWAIT,DIR,PSOJOB,PSOJOBN,PSOA
S PSOJOB="PSONONVA_INACTIVATE "_$J
I $D(^XTMP(PSOJOB)) D
. S PSOJOBN=$J
. F PSOA=1:1:500 Q:'$D(^XTMP(PSOJOB)) D
. . S PSOJOBN=PSOJOBN+1
. . S PSOJOB="PSONONVA INACTIVATE "_PSOJOBN
;
;not checking to see if the 500th attempt is unused
;surely this routine won't be run 500 times using the
;same job number within 60 days
;
S ^XTMP(PSOJOB,0)=$$FMADD^XLFDT(DT,60)_"^"_DT_"^Non-VA Provider Update"
W !!,"Starting -- Please wait ."
S (PSOIEN,PSOWAIT)=0
F S PSOIEN=$O(^VA(200,PSOIEN)) Q:'PSOIEN D
. S PSOWAIT=PSOWAIT+1
. I PSOWAIT#100=0 W "."
. I $P($G(^VA(200,PSOIEN,1)),"^",7)=PSODT,$P($G(^VA(200,PSOIEN,"TPB")),"^")=1,$P($G(^VA(200,PSOIEN,"PS")),"^",9)["NON-VA PROVIDER" D
. . N PSOERR
. . S ^XTMP(PSOJOB,PSODT,PSOIEN)=""
. . S PSOFDA(200,PSOIEN_",",53.4)=DT-1
. . S PSOFDA(200,PSOIEN_",",9.2)=DT-1
. . S PSOFDA(200,PSOIEN_",",7)=1
. . S PSOFDA(200,PSOIEN_",",53.9)=$E($P($G(^VA(200,PSOIEN,"PS")),"^",9),1,18)_"; INACTIVATED BY NON-VA INACTIVATE OPTION"
. . D UPDATE^DIE("","PSOFDA","IEN","PSOERR")
. . I $D(PSOERR("DIERR")) D BMES^XPDUTL(PSOERR("DIERR",1,"TEXT",1))
W !,"Finished."
W !!,"Check ^XTMP(""",PSOJOB,""""," for IEN's which have been inactivated."
W !
S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSONVAP4 3415 printed Nov 22, 2024@17:41:35 Page 2
PSONVAP4 ;HPS/DSK - NON-VA PROVIDER BACKOUT ;May 16, 2018@16:00
+1 ;;7.0;OUTPATIENT PHARMACY;**481**;DEC 1997;Build 31
+2 ;
+3 ;EXTERNAL REFERENCES
+4 ; NEW PERSON FILE - IA #10060 (Supported)
+5 ; NEW PERSON PHARMACY FIELDS - IA #6889 (Private)
+6 ; %DT - IA #10003 (Supported)
+7 ; BMES^XPDUTL - IA #10141 (Supported)
+8 ;
+9 QUIT
+10 ;
EN ;
+1 NEW DIR,DTOUT,DUOUT,Y,PSOQUIT,PSODT
+2 SET PSOQUIT=0
+3 WRITE !!,"This option is to be used ONLY to inactivate non-VA providers"
+4 WRITE !,"which were loaded by the Non-VA Provider Import option."
+5 WRITE !!,"If you proceed, NEW PERSON (#200) file entries which meet"
+6 WRITE !,"the following criteria:",!
+7 WRITE !,?2,"NON-VA PRESCRIBER (#53.91) field = YES"
+8 WRITE !,?2,"REMARKS (#53.9) field contains ""NON-VA PROVIDER"""
+9 WRITE !,?2,"DATE ENTERED (#30) field = the date specified in the ""DATE ENTERED"" prompt"
+10 WRITE !!,"will have:"
+11 WRITE !!,?2,"DISUSER (#7) field set to ""YES"""
+12 WRITE !!,?2,"TERMINATION DATE (#9.2) and INACTIVE DATE (#53.4)"
+13 WRITE !,?2,"fields populated with yesterday's date."
+14 WRITE !,?2,"(Yesterday's date must be used in order to immediately"
+15 WRITE !,?2,"inactivate the providers.)"
+16 WRITE !!,?2,"REMARKS (#53.9) field will have a comment added:"
+17 WRITE !,?2,"""INACTIVATED BY NON-VA INACTIVATE OPTION"".",!
+18 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="NO"
+19 SET DIR("?")="Enter ""Y"" if you wish to proceed."
+20 SET DIR("A")="Do you wish to proceed"
+21 DO ^DIR
KILL DIR
+22 IF 'Y!($DATA(DUOUT))!($DATA(DTOUT))
SET PSOQUIT=1
QUIT
+23 DO ASK
+24 if PSOQUIT
QUIT
+25 DO INACT
+26 QUIT
+27 ;
ASK ;
+1 NEW DIR,%DT,DTOUT,DUOUT,Y
+2 SET %DT="AEPX"
SET %DT("A")="What DATE ENTERED (#30) field value for the entries which should be inactivated? "
+3 DO ^%DT
+4 IF +Y<1!($GET(DTOUT))!($GET(DUOUT))
SET PSOQUIT=1
QUIT
+5 SET PSODT=Y
+6 DO DD^%DT
+7 WRITE !!,"NEW PERSON (#200) file entries for non-VA providers which were entered on"
+8 WRITE !,Y," will be inactivated."
+9 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="NO"
+10 SET DIR("?")="Enter ""Y"" if you wish to proceed."
+11 SET DIR("A")="Do you wish to proceed"
+12 DO ^DIR
KILL DIR
+13 IF 'Y!($DATA(DUOUT))!($DATA(DTOUT))
SET PSOQUIT=1
+14 QUIT
+15 ;
INACT ;
+1 NEW PSOIEN,PSOFDA,PSOWAIT,DIR,PSOJOB,PSOJOBN,PSOA
+2 SET PSOJOB="PSONONVA_INACTIVATE "_$JOB
+3 IF $DATA(^XTMP(PSOJOB))
Begin DoDot:1
+4 SET PSOJOBN=$JOB
+5 FOR PSOA=1:1:500
if '$DATA(^XTMP(PSOJOB))
QUIT
Begin DoDot:2
+6 SET PSOJOBN=PSOJOBN+1
+7 SET PSOJOB="PSONONVA INACTIVATE "_PSOJOBN
End DoDot:2
End DoDot:1
+8 ;
+9 ;not checking to see if the 500th attempt is unused
+10 ;surely this routine won't be run 500 times using the
+11 ;same job number within 60 days
+12 ;
+13 SET ^XTMP(PSOJOB,0)=$$FMADD^XLFDT(DT,60)_"^"_DT_"^Non-VA Provider Update"
+14 WRITE !!,"Starting -- Please wait ."
+15 SET (PSOIEN,PSOWAIT)=0
+16 FOR
SET PSOIEN=$ORDER(^VA(200,PSOIEN))
if 'PSOIEN
QUIT
Begin DoDot:1
+17 SET PSOWAIT=PSOWAIT+1
+18 IF PSOWAIT#100=0
WRITE "."
+19 IF $PIECE($GET(^VA(200,PSOIEN,1)),"^",7)=PSODT
IF $PIECE($GET(^VA(200,PSOIEN,"TPB")),"^")=1
IF $PIECE($GET(^VA(200,PSOIEN,"PS")),"^",9)["NON-VA PROVIDER"
Begin DoDot:2
+20 NEW PSOERR
+21 SET ^XTMP(PSOJOB,PSODT,PSOIEN)=""
+22 SET PSOFDA(200,PSOIEN_",",53.4)=DT-1
+23 SET PSOFDA(200,PSOIEN_",",9.2)=DT-1
+24 SET PSOFDA(200,PSOIEN_",",7)=1
+25 SET PSOFDA(200,PSOIEN_",",53.9)=$EXTRACT($PIECE($GET(^VA(200,PSOIEN,"PS")),"^",9),1,18)_"; INACTIVATED BY NON-VA INACTIVATE OPTION"
+26 DO UPDATE^DIE("","PSOFDA","IEN","PSOERR")
+27 IF $DATA(PSOERR("DIERR"))
DO BMES^XPDUTL(PSOERR("DIERR",1,"TEXT",1))
End DoDot:2
End DoDot:1
+28 WRITE !,"Finished."
+29 WRITE !!,"Check ^XTMP(""",PSOJOB,""""," for IEN's which have been inactivated."
+30 WRITE !
+31 SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
+32 QUIT
