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

ORDEA01.m

Go to the documentation of this file.
  1. ORDEA01 ;ISP/RFR - DEA TOOLS;10/15/2014 08:09
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**218,374,350,499,607**;Dec 17, 1997;Build 7
  1. Q
  1. SITE ;Edit the site-level parameter
  1. N DA,SITE
  1. S DA=$O(^ORD(100.7,0))
  1. I +$G(DA)=0 D
  1. .N FDA,ERROR,IEN
  1. .S SITE=$P($$SITE^VASITE(),U,2)
  1. .S FDA(100.7,"+1,",.01)=SITE,FDA(100.7,"+1,",.02)="YES"
  1. .D UPDATE^DIE("E","FDA","IEN","ERROR")
  1. .I $D(ERROR) D Q
  1. ..N IDX
  1. ..S IDX=0 F S IDX=$O(ERROR("DIERR",IDX)) Q:'IDX D
  1. ...W "FILEMAN ERROR #"_ERROR("DIERR",IDX)_":",!
  1. ...W ERROR("DIERR",IDX,"TEXT",1)
  1. .S DA=IEN(1)
  1. I +$G(DA)>0,($G(SITE)="") S SITE=$$GET1^DIQ(100.7,DA_",",.01)
  1. Q:+$G(DA)=0
  1. W !!,"This option is used to enable or disable electronic prescribing of outpatient",!
  1. W "controlled substances for your entire site. Yes enables it and No disables it.",!
  1. W !,"CONFIGURING SITE "_SITE,!
  1. N DIE,DR
  1. S DIE="^ORD(100.7,",DR=.02
  1. D ^DIE
  1. Q
  1. USER ;Edit user-level parameter
  1. N DA
  1. S DA=$O(^ORD(100.7,0))
  1. I +$G(DA)=0 D Q
  1. .W !!,"NO SITE CONFIGURED.",!!
  1. .W "You must first run the ePCS Site Enable/Disable [OR EPCS SITE PARAMETER] option",!
  1. .W "before running this option.",!
  1. .H 4
  1. W !!,"This option is used to enable or disable electronic prescribing of outpatient",!
  1. W "controlled substances for individual users.",!
  1. W !,"CONFIGURING SITE "_$$GET1^DIQ(100.7,DA_",",.01),!
  1. N EXIT
  1. F D Q:+$G(EXIT)
  1. .N DIC,X,Y,DTOUT,DUOUT,IEN,ACTION,DIR,DIRUT,DIROUT
  1. .S DIC="^VA(200,",DIC(0)="AEQ",DIC("A")="Select the USER NAME: "
  1. .D ^DIC
  1. .S:+Y<1 EXIT=1
  1. .Q:+Y<1
  1. .S IEN=Y,ACTION=$S($D(^ORD(100.7,"C",+IEN)):"enabled^disable",1:"disabled^enable")
  1. .W !!,$P(IEN,U,2)_" is currently "_$P(ACTION,U,1)_"."
  1. .K X,Y
  1. .S DIR(0)="Y^A",DIR("A")="Do you want to "_$P(ACTION,U,2)_" "_$P(IEN,U,2)
  1. .S DIR("B")="NO"
  1. .D ^DIR
  1. .Q:$D(DIRUT)
  1. .I Y=1 D
  1. ..N FDA,ERROR,SCHEDULES,SEX
  1. ..I $P(ACTION,U,1)="disabled" D
  1. ...N RETURN,PROBLEM,OUTPUT,TEXT,DELIMIT,COUNT,SFIEN,DEANUM,INPFLG,NDEAIEN
  1. ...I $O(^VA(200,+IEN,"PS4",0)) D
  1. ....S SFIEN=0 F S SFIEN=$O(^VA(200,+IEN,"PS4",SFIEN)) Q:'SFIEN D
  1. .....S DEANUM=$$GET1^DIQ(200.5321,SFIEN_","_+IEN_",",.01,"E"),NDEAIEN=$$FIND1^DIC(8991.9,,"O",DEANUM,"B",,)
  1. .....S INPFLG=$$GET1^DIQ(8991.9,NDEAIEN,.06,"I") I INPFLG=0 Q
  1. ...S RETURN=$S($O(^VA(200,+IEN,"PS4",0)):$$VDEADNA^XUSER(.RETURN,+IEN,NDEAIEN),1:$$VDEA^XUSER(.RETURN,+IEN))
  1. ...S SEX=$$GET1^DIQ(200,+IEN_",",4),SEX=$S(SEX="MALE":"he",SEX="FEMALE":"she",1:"it")
  1. ...I 'RETURN D
  1. .... S PROBLEM="" F S PROBLEM=$O(RETURN(PROBLEM)) Q:PROBLEM="" D
  1. ..... I PROBLEM["DEA number with no expiration date" K RETURN(PROBLEM)
  1. ..... I PROBLEM["expired DEA number" K RETURN(PROBLEM)
  1. .... S PROBLEM=$O(RETURN("")) I PROBLEM["permitted to prescribe all schedules",$O(RETURN(PROBLEM))="" S RETURN=1
  1. ...I RETURN D
  1. ....S FDA(100.71,"+1,"_DA_",",.01)=+IEN
  1. ....D UPDATE^DIE("S","FDA",,"ERROR")
  1. ...S PROBLEM="" F S PROBLEM=$O(RETURN(PROBLEM)) Q:$G(PROBLEM)="" D
  1. ....I PROBLEM'["Is permitted to prescribe" D
  1. .....S COUNT=+$G(COUNT)+1,PROBLEM(COUNT)=$$LOW^XLFSTR($E(PROBLEM,1))_$P($E(PROBLEM,2,*),".",1)
  1. .....S:PROBLEM(COUNT)["user account status:" PROBLEM(COUNT)=$P(PROBLEM(COUNT),":",1)_" is"_$P(PROBLEM(COUNT),":",2)
  1. ....S:PROBLEM["Is permitted to prescribe" SCHEDULES=$$LOW^XLFSTR($E(PROBLEM,1))_$E(PROBLEM,2,*)
  1. ...S PROBLEM=+$G(COUNT)
  1. ...I 'RETURN D
  1. ....W !!
  1. ....S DELIMIT=", "
  1. ....F COUNT=1:1:PROBLEM D
  1. .....S:COUNT=PROBLEM DELIMIT=" and "
  1. .....S TEXT=$S($G(TEXT)'="":TEXT_DELIMIT,1:"")_PROBLEM(COUNT)
  1. ....S TEXT="Cannot enable "_$P(IEN,U,2)_" to sign controlled substance orders because "_$S($E(TEXT,1,4)'="user":SEX_" ",1:"")_TEXT_"."
  1. ....D WRAP^ORUTL(TEXT,"OUTPUT")
  1. ....F COUNT=1:1:OUTPUT W OUTPUT(COUNT),!
  1. ..I $P(ACTION,U,1)="enabled" D
  1. ...S FDA(100.71,$O(^ORD(100.7,"C",+IEN,DA,0))_","_DA_",",.01)="@"
  1. ...D FILE^DIE("S","FDA","ERROR")
  1. ..I $D(ERROR) D
  1. ...N IDX
  1. ...S IDX=0 F S IDX=$O(ERROR("DIERR",IDX)) Q:'IDX D
  1. ....W !!,"FILEMAN ERROR #"_ERROR("DIERR",IDX)_":",!
  1. ....W ERROR("DIERR",IDX,"TEXT",1),!
  1. ..I '$D(ERROR),($D(FDA)) D
  1. ...N OUTPUT,COUNT,TEXT
  1. ...S TEXT="Successfully "_$P(ACTION,U,2)_"d "_$P(IEN,U,2)
  1. ...S TEXT=TEXT_$S($G(SCHEDULES)'="":" and "_SEX_" "_SCHEDULES,1:".")
  1. ...D WRAP^ORUTL(TEXT,"OUTPUT")
  1. ...W !!
  1. ...F COUNT=1:1:OUTPUT W OUTPUT(COUNT),!
  1. Q
  1. PRVCHK ;CHECK SINGLE PROVIDER IS PROPERLY SETUP
  1. N DIC,Y,X,DTOUT,DUOUT
  1. S DIC="^VA(200,",DIC(0)="AEOQ"
  1. S DIC("A")="Select the provider: "
  1. D ^DIC
  1. Q:+Y<1
  1. W !!
  1. N STATUS,RETURN,TEXT,OUTPUT,LINE,LAST,USING
  1. ;*499 - select if there are multiple DEA #s
  1. S USING=""
  1. S STATUS=$S($O(^VA(200,+Y,"PS4",0)):$$VDEADNM^XUSER(.RETURN,+Y),1:$$VDEA^XUSER(.RETURN,+Y))
  1. S:$P(STATUS,"^",2)'="" USING="Using DEA # "_$P(STATUS,"^",2)_", "
  1. S STATUS=+STATUS
  1. S STATUS=$$CHKSWIT(.RETURN,+Y,STATUS)
  1. I $D(RETURN("Has an expired DEA number.")) S STATUS=0 ;BDB
  1. W USING,!
  1. S TEXT="This provider is"_$S(STATUS=0:" not",1:"")_" able to write controlled substance orders"
  1. I STATUS=0 S OUTPUT=2,OUTPUT(1)=TEXT_" for the",OUTPUT(2)="following reasons:"
  1. I STATUS=1 S TEXT=TEXT_" and "
  1. S RETURN="" F S RETURN=$O(RETURN(RETURN)) Q:$G(RETURN)="" D
  1. .I STATUS=1 D
  1. ..I RETURN["Is permitted to prescribe" D
  1. ...D WRAP^ORUTL(TEXT_"is"_$P(RETURN,"Is",2),"OUTPUT")
  1. ...S TEXT=""
  1. ..I RETURN'["Is permitted to prescribe" D WRAP^ORUTL(RETURN,"LAST")
  1. .I STATUS=0 D
  1. ..I RETURN["Is permitted to prescribe" D WRAP^ORUTL("Once all of the issues above are resolved, the provider is"_$P(RETURN,"Is",2),"LAST")
  1. ..I RETURN'["Is permitted to prescribe" S OUTPUT=OUTPUT+1,OUTPUT(OUTPUT)=RETURN
  1. I '$D(OUTPUT) D WRAP^ORUTL(TEXT_"is permitted to prescribe any schedule.","OUTPUT")
  1. F LINE=1:1:OUTPUT W OUTPUT(LINE),!
  1. I $D(LAST)>9 D
  1. .I STATUS=1 W !,"However, the following item"_$S(LAST=1:" was",1:"s were")_" noted:",!
  1. .F LINE=1:1:+$G(LAST) W LAST(LINE),!
  1. G PRVCHK
  1. Q
  1. CHKSWIT(RETURN,IEN,RETVAL) ;CHECK THE LITTLE SWITCH
  1. I '$D(^ORD(100.7,"C",IEN)) D
  1. .S RETURN("Is not an ENABLED USER in the OE/RR EPCS PARAMETERS file.")="",RETVAL=0
  1. Q RETVAL
  1. REPORTS ;PROMPT THE USER FOR THE REPORT TO RUN
  1. N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,REP
  1. S REP("CFG")="Provider Incomplete Configuration;INCOMPL^ORDEA01A;INCOMPLQ^ORDEA01A"
  1. S REP("DUP")="Duplicate VA Numbers;DUPVA^ORDEA01A;DUPVAQ^ORDEA01A"
  1. ;S REP("DET")="DETOX/MAINTENANCE ID List;DETOX^ORDEA01A;DETOXQ^ORDEA01A" - OR*3*607 - DETOX/X-WAIVER REMOVAL
  1. S REP("LAS")="Provider Last Names Containing Punctuation;LAST^ORDEA01B;LASTQ^ORDEA01B"
  1. S REP("FEE")="Fee Basis/C & A Providers Without a DEA Number;FEEDEA^ORDEA01B;FEEDEAQ^ORDEA01B"
  1. S REP("AUD")="Logical Access Control Audit;AUDIT^ORDEA01B;AUDITQ^ORDEA01B"
  1. S DIR(0)="SO"
  1. S REP="" F S REP=$O(REP(REP)) Q:$G(REP)="" S $P(DIR(0),U,2)=$P(DIR(0),U,2)_REP_":"_$P(REP(REP),";")_";"
  1. S DIR("A")="Select the data validation report to run"
  1. D ^DIR
  1. Q:$D(DIRUT)
  1. Q:'$D(REP(Y))
  1. S REP=Y
  1. D @$P(REP(Y),";",2)
  1. Q
  1. DISPRMPT() ;PROMPT THE USER TO INCLUDE DISUSERED AND TERMINATED USERS
  1. ;RETURNS: ^ IF USER QUIT OR TIMED OUT
  1. ; OTHERWISE, THE VALUE OF VARIABLE Y
  1. N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. S DIR(0)="Y"_U,DIR("A",1)="Do you want to include DISUSERed and TERMINATED users"
  1. S DIR("A")="in the output",DIR("B")="NO"
  1. D ^DIR
  1. Q:$D(DIRUT) U
  1. Q Y