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

PSOEPU1.m

Go to the documentation of this file.
  1. PSOEPU1 ;ALB/BI - DEA Manual Entry ;11/3/21 14:56
  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. ;External reference to XUEPCS DATA file (#8991.6) is supported by DBIA 7015
  1. ;External reference to XUEPCS PSDRPH AUDIT file (#8991.7) is supported by DBIA 7016
  1. ;External reference to KEYS sub-file (#200.051) is supported by DBIA 7054
  1. ;References to Cache methods class.HttpResponse, class.Data, class.AtEnd, class.ReadLine() are supported by SAC exemption 20210601-01
  1. ;
  1. Q
  1. ;
  1. WSGET(FG,DEA) ; Function to Get the Remote DEA information, Return in FG.
  1. ; INPUT: DEA ;Properly formatted DEA Number for lookup.
  1. ;
  1. ; OUTPUT: FG ;Web Service Response Global
  1. ;
  1. ; RETURN: Status code with a text message.
  1. ; If not filled successfully a "0^Error Message" will be returned.
  1. ;
  1. Q $$WSGET^PSODEAU0(.FG,DEA)
  1. ;
  1. FILEFM(RET,DATA,NPIEN) ; -- File DEA Information in the DEA NUMBERS FILE #8991.9
  1. ; Invoked by RPC: PSO EPCS ADD DEA
  1. N DNDEAIEN,DNDEATXT,FDA,IENROOT,IENS,MSGROOT,SUFFIX,XSTATE,XIP,WSDOWN
  1. S RET=0
  1. I '$D(DATA) S RET=0 G FILEFMX
  1. ;
  1. S DNDEATXT=$P(DATA,U,11) I DNDEATXT="" G FILEFMX
  1. S DNDEAIEN=$O(^XTV(8991.9,"B",DNDEATXT,0))
  1. S IENS=$S($G(DNDEAIEN):$G(DNDEAIEN)_",",1:"+1,")
  1. ;
  1. ; INPUT: DATA - A STRING OF DEA INFORMATION DELIMITED BY THE "^"
  1. S FDA(1,8991.9,IENS,1.1)=$P(DATA,U,1) ; 1 - PROVIDER NAME
  1. S FDA(1,8991.9,IENS,1.2)=$P(DATA,U,2) ; 2 - ADDRESS 1
  1. S FDA(1,8991.9,IENS,1.3)=$P(DATA,U,3) ; 3 - ADDRESS 2
  1. S FDA(1,8991.9,IENS,1.4)=$P(DATA,U,4) ; 4 - ADDRESS 3
  1. S FDA(1,8991.9,IENS,1.5)=$P(DATA,U,5) ; 5 - CITY
  1. ;
  1. ; Special State Processing
  1. D POSTAL^XIPUTIL($P(DATA,U,8),.XIP)
  1. S XSTATE=$G(XIP("STATE"))
  1. I XSTATE'="" S FDA(1,8991.9,IENS,1.6)=XSTATE ; 6 - STATE
  1. ;
  1. S FDA(1,8991.9,IENS,1.7)=$P(DATA,U,8) ; 8 - ZIP CODE
  1. S FDA(1,8991.9,IENS,.02)=$P(DATA,U,9) ; 9 - ACTIVITY CODE
  1. I $P(DATA,U,9)]"" D
  1. . N BAC,FDB,ERR,SCREEN,RETURN,ERROR
  1. . S BAC=$P(DATA,U,9)
  1. . ;
  1. . ; Just in case there are multiple BAC's with the same name, D LIST^DIC instead of $$FIND1^DIC
  1. . ; Quit if this ACTIVITY CODE is already on file
  1. . S SCREEN="I $P($G(^(0)),U)="""_BAC_""""
  1. . D LIST^DIC(8991.8,,.01,,,,,,.SCREEN,,"RETURN","ERROR")
  1. . Q:+$G(RETURN("DILIST",0))>0
  1. . ;
  1. . S FDB(8991.8,"?+1,",.01)=BAC
  1. . S FDB(8991.8,"?+1,",.02)=$E(BAC)
  1. . S FDB(8991.8,"?+1,",.03)=$E(BAC,2,3)
  1. . D UPDATE^DIE("E","FDB",,"ERR")
  1. . Q
  1. S FDA(1,8991.9,IENS,.07)=$P(DATA,U,10) ; 10 - TYPE
  1. S FDA(1,8991.9,IENS,.01)=$P(DATA,U,11) ; 11 - DEA NUMBER
  1. S FDA(1,8991.9,IENS,.04)=$P(DATA,U,12) ; 12 - EXPIRATION DATE
  1. S FDA(1,8991.9,IENS,10.2)="N" ; 13 - PROCESSED DATE
  1. I ($$DEANUM^PSOEPUT($P(DATA,U,14)))!($P(DATA,U,14)="") D ; ONLY CLEAR AND SET IF VALIDATED
  1. . I $P(DATA,U,14)'="" D CLEARDTX^PSOEPUT(NPIEN) ; REMOVE DETOX NUMBERS FROM OTHER DEA NUMBERS
  1. . S FDA(1,8991.9,IENS,.03)=$P(DATA,U,14) ; 14 - DETOX NUMBER
  1. I $P(DATA,U,21)["Y" D CLEARINP^PSOEPU1(NPIEN) ; REMOVE INPATIENT FLAG FROM OTHER DEA NUMBERS
  1. I $P(DATA,U,10)="INDIVIDUAL" D
  1. . S FDA(1,8991.9,IENS,2.1)=$P(DATA,U,15) ; 15 - SCHEDULE II NARCOTIC
  1. . S FDA(1,8991.9,IENS,2.2)=$P(DATA,U,16) ; 16 - SCHEDULE II NON-NARCOTIC
  1. . S FDA(1,8991.9,IENS,2.3)=$P(DATA,U,17) ; 17 - SCHEDULE III NARCOTIC
  1. . S FDA(1,8991.9,IENS,2.4)=$P(DATA,U,18) ; 18 - SCHEDULE III NON-NARCOTIC
  1. . S FDA(1,8991.9,IENS,2.5)=$P(DATA,U,19) ; 19 - SCHEDULE IV
  1. . S FDA(1,8991.9,IENS,2.6)=$P(DATA,U,20) ; 20 - SCHEDULE V
  1. I $P(DATA,U,10)'="INDIVIDUAL" D
  1. . N SRET,SDEA
  1. . S SDEA=$P(DATA,U,11) ;dea number
  1. . D DEADOJ^PSOEPUT(.SRET,SDEA) ;call doj server for doj institutional schedules
  1. . I SRET(0) D ;doj server is up
  1. . . S FDA(1,8991.9,IENS,2.1)=$P(SRET(1),"^",15) ; 15 - SCHEDULE II NARCOTIC
  1. . . S FDA(1,8991.9,IENS,2.2)=$P(SRET(1),"^",16) ; 16 - SCHEDULE II NON-NARCOTIC
  1. . . S FDA(1,8991.9,IENS,2.3)=$P(SRET(1),"^",17) ; 17 - SCHEDULE III NARCOTIC
  1. . . S FDA(1,8991.9,IENS,2.4)=$P(SRET(1),"^",18) ; 18 - SCHEDULE III NON-NARCOTIC
  1. . . S FDA(1,8991.9,IENS,2.5)=$P(SRET(1),"^",19) ; 19 - SCHEDULE IV
  1. . . S FDA(1,8991.9,IENS,2.6)=$P(SRET(1),"^",20) ; 20 - SCHEDULE V
  1. . ;
  1. S FDA(1,8991.9,IENS,.06)=$P(DATA,U,21) ; 21 - USE FOR INPATIENT FLAG
  1. S SUFFIX=$P(DATA,U,22) ; 22 - DEA INSTITUTIONAL SUFFIX
  1. ;
  1. ; Last Date/Time updated by DEA/DOJ web service. Adds/removes the DEA number to/from the PSO EPCS MANUAL DEA REPORT
  1. S WSDOWN='$$CONNECT^PSODEADD
  1. S FDA(1,8991.9,IENS,10.3)=$S(WSDOWN:"",1:$$NOW^XLFDT)
  1. ;
  1. D UPDATE^DIE("E","FDA(1)","IENROOT","MSGROOT")
  1. I $D(MSGROOT) D G FILEFMX
  1. . S RET="0^DATA DIDN'T FILE SUCCESSFULLY."
  1. . S RET(1)=$G(MSGROOT("DIERR",1,"TEXT",1))
  1. S DNDEAIEN=$S($D(IENROOT(1)):IENROOT(1)_",",1:IENS)
  1. I '+DNDEAIEN S RET="0^DATA DIDN'T FILE SUCCESSFULLY." G FILEFMX
  1. S FDA(2,8991.9,DNDEAIEN,10.1)=$G(DUZ) D FILE^DIE("","FDA(2)","MSGROOT")
  1. S:DNDEAIEN RET=+DNDEAIEN_"^SUCCESSFULLY SAVED/UPDATED IN 8991.9"
  1. I $L(DNDEATXT),$G(NPIEN),$G(DNDEAIEN) S RET=RET_"^"_$$NPFILE^PSOEPUT(DNDEATXT,NPIEN,DNDEAIEN,SUFFIX)
  1. ;I RET,$P(DATA,U,21)="YES" S FDA(200,NPIEN_",",53.2)=$P(DATA,U,11) D UPDATE^DIE(,"FDA")
  1. I $P(RET,"^",3),$G(NPIEN),$P($G(DATA),"^",10)'="INDIVIDUAL" S RET=RET_"^"_$$NPSFILE^PSOEPUT(NPIEN,DATA)
  1. FILEFMX ; -- Subroutine Exit Point
  1. Q
  1. ;
  1. DNDEAGET(RET,DEA) ;
  1. I '$D(^XTV(8991.9,"B",DEA)) S RET(0)="0^7^DEA number not on file" Q
  1. I $D(^XTV(8991.9,"B",DEA)) S DNDEAIEN=$O(^XTV(8991.9,"B",DEA,0)) I +DNDEAIEN D
  1. . K DNDEADAT D GETS^DIQ(8991.9,DNDEAIEN,"**","","DNDEADAT")
  1. . K RET(1)
  1. . S RET(1)=""
  1. . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",1.1))_"^" ; PROVIDER NAME
  1. . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",1.2))_"^" ; ADDRESS 1
  1. . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",1.3))_"^" ; ADDRESS 2
  1. . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",1.4))_"^" ; ADDRESS 3
  1. . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",1.5))_"^" ; CITY
  1. . ;
  1. . ; Special State Processing
  1. . N XSTATE,XSTATEAB,XIP,BAC,X,Y D POSTAL^XIPUTIL($G(DNDEADAT(8991.9,DNDEAIEN_",",1.7)),.XIP)
  1. . S XSTATEAB="" I $G(XIP("ERROR"))="" S XSTATEAB=$$GET1^DIQ(5,XIP("STATE POINTER"),1)
  1. . S RET(1)=RET(1)_XSTATEAB_"^" ; STATE ABREVIATION
  1. . S XSTATE=$G(XIP("STATE"))
  1. . S RET(1)=RET(1)_$G(XSTATE)_"^" ; STATE
  1. . ;
  1. . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",1.7))_"^" ; ZIP CODE
  1. . S BAC=$G(DNDEADAT(8991.9,DNDEAIEN_",",.02)) ; ACTIVITY CODE
  1. . S RET(1)=RET(1)_BAC_"^" ; ACTIVITY CODE
  1. . S RET(1)=RET(1)_$P($$PROVTYPE^PSODEAUT($G(BAC)),"^",2)_"^" ; TYPE
  1. . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",.01))_"^" ; DEA NUMBER
  1. . S X=$P($G(DNDEADAT(8991.9,DNDEAIEN_",",.04)),"@") D ^%DT
  1. . S RET(1)=RET(1)_$$FMTHL7^XLFDT(Y)_"^" ; EXPIRATION DATE
  1. . S X=$P($G(DNDEADAT(8991.9,DNDEAIEN_",",10.2)),"@") D ^%DT
  1. . S RET(1)=RET(1)_$$FMTHL7^XLFDT(Y)_"^" ; PROCESSED DATE
  1. . S RET(1)=RET(1)_""_"^" ; DETOX NUMBER ;P731 detox/x-waiver removal
  1. . I $G(DNDEADAT(8991.9,DNDEAIEN_",",.07))="INDIVIDUAL" D
  1. . . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",2.1))_"^" ; SCHEDULE II NARCOTIC
  1. . . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",2.2))_"^" ; SCHEDULE II NON-NARCOTIC
  1. . . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",2.3))_"^" ; SCHEDULE III NARCOTIC
  1. . . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",2.4))_"^" ; SCHEDULE III NON-NARCOTIC
  1. . . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",2.5))_"^" ; SCHEDULE IV
  1. . . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",2.6)) ; SCHEDULE V
  1. . I $G(DNDEADAT(8991.9,DNDEAIEN_",",.07))'="INDIVIDUAL" D
  1. . . S RET(1)=RET(1)_"^" ; SCHEDULE II NARCOTIC
  1. . . S RET(1)=RET(1)_"^" ; SCHEDULE II NON-NARCOTIC
  1. . . S RET(1)=RET(1)_"^" ; SCHEDULE III NARCOTIC
  1. . . S RET(1)=RET(1)_"^" ; SCHEDULE III NON-NARCOTIC
  1. . . S RET(1)=RET(1)_"^" ; SCHEDULE IV
  1. . . S RET(1)=RET(1)_"^" ; SCHEDULE V
  1. ;
  1. CLEARINP(NPIEN) ; REMOVE INPATIENT FLAG FROM ALL OF A PROVIDERS DEA NUMBERS
  1. N DNDEAIEN,FDA,NPDEAIEN
  1. S NPDEAIEN=0 F S NPDEAIEN=$O(^VA(200,NPIEN,"PS4",NPDEAIEN)) Q:'NPDEAIEN D
  1. . S DNDEAIEN=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.03,"I")
  1. . K FDA S FDA(1,8991.9,DNDEAIEN_",",.06)="@" D UPDATE^DIE("","FDA(1)") K FDA
  1. Q
  1. ;
  1. DTXCHK(RET,DEA,DETOX) ; -- Check Detox Number
  1. Q 1 ;P731 detox/x-waiver removal
  1. S RET=0
  1. I $L(DETOX)>9!($L(DETOX)<9) S RET="0^1^DETOX length error" Q
  1. I $S("ABCDEFGHIJKLMNOPQRSTUVWXYZ"[$E(DETOX):1,1:0)=0 S RET="0^2^DETOX first character error" Q
  1. I $S("ABCDEFGHIJKLMNOPQRSTUVWXYZ"[$E(DETOX,2):2,1:0)=0 S RET="0^3^DETOX second character error" Q
  1. I $$DEANUM^PSOEPUT(DETOX)=0 S RET="0^4^DETOX number error" Q
  1. I $$DETOXDUP(DEA,DETOX,.DUPDEA)=1 S RET="0^5^Duplicate DETOX number with DEA number "_DUPDEA Q
  1. S DNDEA=$$PRVRDTX(DEA) I DNDEA]"" S RET="0^6^Provider's profile already has a DETOX number for DEA number "_DNDEA Q
  1. S RET=1
  1. Q
  1. ;
  1. DETOXDUP(DEA,DETOX,DUPDEA) ; -- Check for duplicate Detox number
  1. Q 0 ;P731 detox/x-waiver removal
  1. N I,NXTDEA,NPIEN,NPNAME S NXTDEA=0,DUPDEA=""
  1. I $G(DETOX)=""!($G(DEA)="") Q 0 ; Missing required input, can't check
  1. I '$D(^XTV(8991.9,"D",$G(DETOX))) Q 0 ; If Detox not on file, not a duplicate
  1. I $D(^XTV(8991.9,"D",$G(DETOX))),'$D(^XTV(8991.9,"D",$G(DETOX),$G(DEA))) D Q 1 ; On file for another prescriber, duplicate
  1. .S DUPDEA=$O(^XTV(8991.9,"D",$G(DETOX),$G(DUPDEA)))
  1. .S NPIEN=0 S NPIEN=$O(^VA(200,"PS4",DUPDEA,NPIEN)) Q:NPIEN=""
  1. .S NPNAME=$$GET1^DIQ(200,NPIEN_",",.01)
  1. .S DUPDEA=DUPDEA_"^"_NPNAME
  1. F S NXTDEA=$O(^XTV(8991.9,"D",DETOX,NXTDEA)) Q:NXTDEA="" I NXTDEA'=DEA S DUPDEA=$S($G(DUPDEA)'="":DUPDEA_","_NXTDEA,1:NXTDEA)
  1. I $G(DUPDEA)'="" Q 1 ; If more than one entry on file for this Detox number, duplicate
  1. Q 0
  1. ;
  1. PRVRDTX(DEA) ; -- Check for DETOX numbers on provider profile
  1. Q "" ;P731 detox/x-waiver removal
  1. N NPIEN,DNDEA
  1. S DNDEA=""
  1. S NPIEN=$O(^VA(200,"PS4",DEA,0)) I NPIEN']"" Q DNDEA
  1. S DNDEA=$$GTDNDTX(NPIEN)
  1. Q DNDEA
  1. ;
  1. GTDNDTX(NPIEN) ; GET A SINGLE DETOX NUMBER FROM ALL OF A PROVIDERS DEA NUMBERS IN 8991.9
  1. Q "" ;P731 detox/x-waiver removal
  1. N GETDNDTX,DNDEAIEN,NPDEAIEN,DNDEA S GETDNDTX=""
  1. S NPDEAIEN=0 F S NPDEAIEN=$O(^VA(200,NPIEN,"PS4",NPDEAIEN)) Q:'NPDEAIEN D Q:DNDEA]""
  1. . S DNDEA=""
  1. . S DNDEAIEN=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.03,"I") Q:'DNDEAIEN
  1. . S GETDNDTX=$$GET1^DIQ(8991.9,DNDEAIEN_",",.03)
  1. . I GETDNDTX]"" S DNDEA=$$GET1^DIQ(8991.9,DNDEAIEN_",",.01)
  1. Q DNDEA
  1. ;
  1. VANUMCHK(RET,VANUM,NPIEN) ;Check that the VA# is unique
  1. N IEN,PSNM
  1. S RET="1^Success"
  1. I $D(^VA(200,"PS2",VANUM)) D
  1. . S IEN=0
  1. . F S IEN=$O(^VA(200,"PS2",VANUM,IEN)) Q:'IEN I IEN'=NPIEN K VANUM Q
  1. . Q
  1. I '$D(VANUM) S PSNM=$$GET1^DIQ(200,IEN,.01) S RET="0^VA# in use by "_PSNM
  1. Q
  1. ;
  1. FILEFMA(RET,FIELD,DATA,NPIEN) ; -- Filer for file #200
  1. ; Invoked by RPC: PSO EPCS FILER
  1. N FDA,IENS,MSGROOT
  1. S RET="1^Success"
  1. I '$D(FIELD)!'$D(DATA)!'$D(NPIEN) S RET=0 G FILEFMAX
  1. ;
  1. ; INPUT: DATA - A SINGLE DATA ITEM
  1. S IENS=NPIEN_","
  1. S FDA(200,IENS,FIELD)=$P(DATA,U,1)
  1. ;
  1. D UPDATE^DIE("E","FDA",,"MSGROOT")
  1. I $D(MSGROOT) S RET="0^Data did not file successfully."
  1. FILEFMAX ; -- Subroutine Exit Point
  1. Q
  1. ;
  1. SETINP(NPIEN) ;SET THE INPATIENT FLAG IF ONLY ONE INDIVIDUAL DEA NUMBER
  1. N DNDEAIEN,FDA,NPDEAIEN,CNT,DNDEA
  1. S CNT=0,DNDEA=""
  1. S NPDEAIEN=0 F S NPDEAIEN=$O(^VA(200,NPIEN,"PS4",NPDEAIEN)) Q:'NPDEAIEN D
  1. . S DNDEAIEN=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.03,"I")
  1. . Q:($$GET1^DIQ(8991.9,DNDEAIEN_",",.07,"I")'=2) ;quit not individual
  1. . S CNT=CNT+1
  1. . I $$GET1^DIQ(8991.9,DNDEAIEN_",",.06)'="YES" S DNDEA=DNDEAIEN ;candidate dea
  1. I (CNT=1)&(DNDEA]"") D
  1. . K FDA S FDA(1,8991.9,DNDEA_",",.06)=1 D UPDATE^DIE("","FDA(1)") K FDA
  1. Q
  1. ;
  1. SETINP2(NPIEN,NPDEAIEN) ;Set the inpatient flag if other dea has no inpat flag
  1. ; NPIEN - Provider ien in file #200 being filed
  1. ; NPDEAIEN - New dea multiple ien with no inp flag
  1. ;
  1. N NPDEAIET,FDA,CNT,DNDEA,QFLG
  1. S CNT=0,DNDEA="",QFLG=0
  1. S NPDEAIET=0 F S NPDEAIET=$O(^VA(200,NPIEN,"PS4",NPDEAIET)) Q:'NPDEAIET D Q:QFLG
  1. . S DNDEAIEN=$$GET1^DIQ(200.5321,NPDEAIET_","_NPIEN_",",.03,"I")
  1. . Q:($$GET1^DIQ(8991.9,DNDEAIEN_",",.07,"I")'=2) ;quit not individual
  1. . I $$GET1^DIQ(8991.9,DNDEAIEN_",",.06)="YES" S QFLG=1 ;a dea is set for inpat
  1. . S CNT=CNT+1
  1. . I $$GET1^DIQ(8991.9,DNDEAIEN_",",.06)'="YES" I NPDEAIET'=NPDEAIEN S DNDEA=DNDEAIEN ;candidate dea
  1. I ('QFLG)&(CNT=2)&(DNDEA]"") D
  1. . K FDA S FDA(1,8991.9,DNDEA_",",.06)=1 D UPDATE^DIE("","FDA(1)") K FDA
  1. Q
  1. ;
  1. NPSCHDL(RET,NPIEN) ; -- RPC to return the file #200 schedule information for a single provider.
  1. ; INPUT: NPIEN - NEW PERSON FILE #200 INTERNAL ENTRY NUMBER
  1. ;
  1. ; OUTPUT: RET - NULL OR A STRING OF SCHEDULE INFORMATION DELIMITED BY THE "^"
  1. ; 1 - SCHEDULE II NARCOTIC
  1. ; 2 - SCHEDULE II NON-NARCOTIC
  1. ; 3 - SCHEDULE III NARCOTIC
  1. ; 4 - SCHEDULE III NON-NARCOTIC
  1. ; 5 - SCHEDULE IV
  1. ; 6 - SCHEDULE V
  1. ;
  1. N NPSCHED
  1. K RET S RET=""
  1. Q:'$G(NPIEN)
  1. Q:'$D(^VA(200,NPIEN))
  1. ;
  1. K NPSCHED D GETS^DIQ(200,NPIEN_",","55.1:55.6","E","NPSCHED")
  1. S RET=RET_NPSCHED(200,NPIEN_",",55.1,"E")_"^" ; SCHEDULE II NARCOTIC
  1. S RET=RET_NPSCHED(200,NPIEN_",",55.2,"E")_"^" ; SCHEDULE II NON-NARCOTIC
  1. S RET=RET_NPSCHED(200,NPIEN_",",55.3,"E")_"^" ; SCHEDULE III NARCOTIC
  1. S RET=RET_NPSCHED(200,NPIEN_",",55.4,"E")_"^" ; SCHEDULE III NON-NARCOTIC
  1. S RET=RET_NPSCHED(200,NPIEN_",",55.5,"E")_"^" ; SCHEDULE IV
  1. S RET=RET_NPSCHED(200,NPIEN_",",55.6,"E") ; SCHEDULE V
  1. Q
  1. ;
  1. NPSCHDF(RET,NPIEN,DATA) ; -- RPC to file the file #200 schedule information for a single provider.
  1. ; INPUT: NPIEN - NEW PERSON FILE #200 INTERNAL ENTRY NUMBER
  1. ;
  1. ; DATA - A STRING OF DEA INFORMATION DELIMITED BY THE "^"
  1. ; 1 - SCHEDULE II NARCOTIC
  1. ; 2 - SCHEDULE II NON-NARCOTIC
  1. ; 3 - SCHEDULE III NARCOTIC
  1. ; 4 - SCHEDULE III NON-NARCOTIC
  1. ; 5 - SCHEDULE IV
  1. ; 6 - SCHEDULE V
  1. ;
  1. ; OUTPUT: RET - 0 OR 1^SUCCESS OR FAILURE TEXT
  1. ;
  1. N FDA,IENROOT,MSGROOT
  1. K RET
  1. I '$G(NPIEN) S RET="0^DATA DIDN'T FILE SUCCESSFULLY IN NPSFILE." Q
  1. I '$D(^VA(200,NPIEN)) S RET="0^DATA DIDN'T FILE SUCCESSFULLY IN NPSFILE." Q
  1. S FDA(3,200,NPIEN_",",55.1)=$E($P(DATA,U,1),1) ; 1 - SCHEDULE II NARCOTIC
  1. S FDA(3,200,NPIEN_",",55.2)=$E($P(DATA,U,2),1) ; 2 - SCHEDULE II NON-NARCOTIC
  1. S FDA(3,200,NPIEN_",",55.3)=$E($P(DATA,U,3),1) ; 3 - SCHEDULE III NARCOTIC
  1. S FDA(3,200,NPIEN_",",55.4)=$E($P(DATA,U,4),1) ; 4 - SCHEDULE III NON-NARCOTIC
  1. S FDA(3,200,NPIEN_",",55.5)=$E($P(DATA,U,5),1) ; 5 - SCHEDULE IV
  1. S FDA(3,200,NPIEN_",",55.6)=$E($P(DATA,U,6),1) ; 6 - SCHEDULE V
  1. D UPDATE^DIE("E","FDA(3)","IENROOT","MSGROOT")
  1. I $D(MSGROOT) S RET="0^DATA DIDN'T FILE SUCCESSFULLY IN NPSFILE." Q
  1. S RET="1^SCHEDULES SUCCESSFULLY SAVED/UPDATED IN 200"
  1. Q
  1. ;
  1. OPTNDESC(RET,OPTNM) ; -- RPC to return Option file #19 description word processing text
  1. ; INPUT: OPTNM - NAME FIELD OF THE OPTION
  1. ;
  1. ; OUTPUT: RET ARRAY - OPTION FILE #19 DESCRIPTION WORD PROCESSING TEXT
  1. ;
  1. N DA,ARR
  1. K RET
  1. S DA=$$FIND1^DIC(19,,,OPTNM)
  1. S ARR=$$GET1^DIQ(19,DA,3.5,"Z","ARR")
  1. S DA=0 F S DA=$O(ARR(DA)) Q:'DA S RET(DA)=ARR(DA,0)
  1. Q