352 lines
15 KiB
Mathematica
352 lines
15 KiB
Mathematica
C0PSUB ; ERX/GPL - ERX SUBSCRIBER utilities; 5/8/12 9:51pm
|
|
;;1.0;C0P;;Apr 25, 2012;Build 103
|
|
;Copyright 2009 George Lilly. Licensed under the terms of the GNU
|
|
;General Public License See attached copy of the License.
|
|
;
|
|
;This program is free software; you can redistribute it and/or modify
|
|
;it under the terms of the GNU General Public License as published by
|
|
;the Free Software Foundation; either version 2 of the License, or
|
|
;(at your option) any later version.
|
|
;
|
|
;This program is distributed in the hope that it will be useful,
|
|
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;GNU General Public License for more details.
|
|
;
|
|
;You should have received a copy of the GNU General Public License along
|
|
;with this program; if not, write to the Free Software Foundation, Inc.,
|
|
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
;
|
|
QUIT
|
|
EN(INARY,C0PDUZ) ; creates the array inary passed by name for subscriber
|
|
; variables, mostly from the new person file
|
|
; SUBSCRIBER-FAMILY-NAME
|
|
; SUBSCRIBER-GIVEN-NAME
|
|
; SUBSCRIBER-MIDDLE-NAME
|
|
; LOCATION-PHONE
|
|
; LOCATION-FAX
|
|
; ACCOUNT-PHONE
|
|
; ACCOUNT-FAX
|
|
; LOCATION-ADDRESS1
|
|
; LOCATION-ADDRESS2
|
|
; LOCATION-CITY
|
|
; LOCATION-ZIP
|
|
; LOCATION-ZIP4
|
|
; LOCATION-STATE
|
|
; SUBSCRIBER-LICENSE
|
|
; SUBSCRIBER-LICENSE-STATE
|
|
; SUBSCRIBER-USERROLE
|
|
; SUBSCRIBER-USER
|
|
; ACCOUNT-COUNTRY
|
|
; ACCOUNT-ADDRESS-ZIP4
|
|
; LOCATION-COUNTRY
|
|
; REQUESTED-PAGE
|
|
D FAMILY(INARY,"SUBCRIBER-FAMILY-NAME",C0PDUZ)
|
|
D GIVEN(INARY,"SUBCRIBER-GIVEN-NAME",C0PDUZ)
|
|
D MIDDLE(INARY,"SUBCRIBER-MIDDLE-NAME",C0PDUZ)
|
|
D PHONEFAX(INARY,C0PLOC) ; SETS "LOCATION-PHONE" AND "LOCATION-FAX"
|
|
D ACTPHFAX(INARY,C0PACCT) ;SETS "ACCOUNT-PHONE" AND "ACCOUNT-FAX"
|
|
D GETLOC(INARY,C0PLOC) ;SETS "LOCATION-" VARIABLES (SEE ROUTINE FOR LIST)
|
|
D STLIC(INARY,C0PDUZ,C0PACCT) ;LICENSE AND LICENSE STATE
|
|
S C0PAF=113059002 ; FILE NUMBER FOR ACCOUNT FILE
|
|
S @INARY@("ACCOUNT-PARTNERNAME")=$$GET1^DIQ(C0PAF,C0PACCT_",",3.1) ;
|
|
I @INARY@("ACCOUNT-PARTNERNAME")="" S @INARY@("ACCOUNT-PARTNERNAME")="demo"
|
|
; todo: NPs, PAs, assistants need different roles
|
|
D SETACCT(INARY,C0PDUZ) ; SET SUBSCRIBER VARIABLES
|
|
;S @INARY@("SUBSCRIBER-USERROLE")="doctor" ; BASE CASE ACCESS
|
|
;S @INARY@("SUBSCRIBER-USER")="LicensedPrescriber" ; BASE CASE ACCESS
|
|
S @INARY@("ACCOUNT-COUNTRY")="US" ;BASE CASE ACCESS
|
|
S @INARY@("ACCOUNT-ADDRESS-ZIP4")="" ;DON'T HAVE THIS
|
|
S @INARY@("LOCATION-COUNTRY")="US" ; NOT IN FILE
|
|
S @INARY@("REQUESTED-PAGE")="compose" ; DEFAULT PAG
|
|
S @INARY@("ACCOUNT-ACCOUNTID")=$$GET1^DIQ(C0PAF,C0PACCT_",",2.4)
|
|
I @INARY@("ACCOUNT-ACCOUNTID")="" S @INARY@("ACCOUNT-ACCOUNTID")="demo"
|
|
S @INARY@("ACCOUNT-NAME")=$$GET1^DIQ(C0PAF,C0PACCT_",",3)
|
|
I @INARY@("ACCOUNT-NAME")="" S @INARY@("ACCOUNT-NAME")="demo"
|
|
S @INARY@("ACCOUNT-PASSWORD")=$$GET1^DIQ(C0PAF,C0PACCT_",",3.2)
|
|
I @INARY@("ACCOUNT-PASSWORD")="" S @INARY@("ACCOUNT-PASSWORD")="demo"
|
|
;S @INARY@("SUBSCRIBER-USERTYPE")="Doctor" ; IS RESET LATER
|
|
;S @INARY@("SUBSCRIBER-USERID")="demo" ; IS RESET LATER
|
|
;N NPI S NPI=$$NPI^XUSNPI("Individual_ID",C0PDUZ)
|
|
;S @INARY@("SUBSCRIBER-SID")=+NPI ; FOR NOW
|
|
;
|
|
Q
|
|
;
|
|
ACTPHFAX(RARY,ZACCT) ;SET ACCOUNT PHONE AND FAX FROM ACCOUNT FILE
|
|
; ZACCT IS A POINTER TO THE ACCOUNT FILE
|
|
S C0PAF=113059002 ; FILE NUMBER FOR ACCOUNT FILE
|
|
S @RARY@("ACCOUNT-PHONE")=$$GET1^DIQ(C0PAF,ZACCT_",",2.2) ;PHONE NUMBER
|
|
S @RARY@("ACCOUNT-FAX")=$$GET1^DIQ(C0PAF,ZACCT_",",2.1) ; FAX NUMBER
|
|
Q
|
|
;
|
|
PHONEFAX(RARY,C0PLOC) ; SET LOCATION PHONE AND FAX INTO THE RETURN ARRAY
|
|
N PRIORITY,LOCIEN
|
|
S PRIORITY=$O(^SC(C0PLOC,"C0P","PRIORITY",""))
|
|
I PRIORITY="" W "NO LOCATION PHONE SET",! Q
|
|
S LOCIEN=$O(^SC(C0PLOC,"C0P","PRIORITY",PRIORITY,""))
|
|
S C0PLOCF=44.113059
|
|
S @RARY@("LOCATION-PHONE")=$$GET1^DIQ(C0PLOCF,LOCIEN_","_C0PLOC_",",1)
|
|
S @RARY@("LOCATION-FAX")=$$GET1^DIQ(C0PLOCF,LOCIEN_","_C0PLOC_",",2)
|
|
Q
|
|
;
|
|
GETLOC(RARY,ZLOC) ; GETS LOCATIONS VARIABLE FROM POINTER ZLOC
|
|
; TO THE HOSPITAL LOCATION FILE
|
|
; THE LOCATION ADDRESS IS FOUND IN NEW FIELDS IN THE HOSPITAL LOCATION FILE 44
|
|
; IF THESE ARE NULL, THE ADDRESS WILL BE TAKEN FROM THE INSTITUTION FILE,
|
|
; WHICH IS POINTED TO BY THE FILE 44
|
|
;
|
|
S @RARY@("LOCATION-SITEID")="LOCATION_"_ZLOC ; SITE ID
|
|
S @RARY@("LOCATION-ADDRESS1")=$$GET1^DIQ(44,ZLOC_",",113059111) ;ADDR1
|
|
I @RARY@("LOCATION-ADDRESS1")'="" D ; ADDRESS PRESENT IN 44
|
|
. S @RARY@("LOCATION-ADDRESS2")=$$GET1^DIQ(44,ZLOC_",",113059112) ;ADDR2
|
|
. S @RARY@("LOCATION-CITY")=$$GET1^DIQ(44,ZLOC_",",113059114) ;CITY
|
|
. S @RARY@("LOCATION-ZIP")=$$GET1^DIQ(44,ZLOC_",",113059116) ;ZIP
|
|
. S @RARY@("LOCATION-ZIP4")="" ;NO ZIP4
|
|
. N ZJ
|
|
. S ZJ=$$GET1^DIQ(44,ZLOC_",",113059115,"I") ;STATE
|
|
. S @RARY@("LOCATION-STATE")=$$GET1^DIQ(5,ZJ_",",1) ;STATE ABBREVIATION
|
|
E D ; TAKE THE ADDRESS FROM THE INSTITUTION FILE
|
|
. N ZI
|
|
. S ZI=$$GET1^DIQ(44,ZLOC_",",3,"I") ; POINTER TO INSTITUTION FILE
|
|
. S @RARY@("LOCATION-ADDRESS1")=$$GET1^DIQ(4,ZI_",",1.01) ;ADDR1
|
|
. S @RARY@("LOCATION-ADDRESS2")=$$GET1^DIQ(4,ZI_",",1.02) ;ADDR2
|
|
. S @RARY@("LOCATION-CITY")=$$GET1^DIQ(4,ZI_",",1.03) ;CITY
|
|
. S @RARY@("LOCATION-ZIP")=$$GET1^DIQ(4,ZI_",",1.04) ;ZIP
|
|
. S @RARY@("LOCATION-ZIP4")="" ;NO ZIP4
|
|
. N ZJ
|
|
. S ZJ=$$GET1^DIQ(4,ZI_",",.02,"I") ;STATE
|
|
. S @RARY@("LOCATION-STATE")=$$GET1^DIQ(5,ZJ_",",1) ;STATE ABBREVIATION
|
|
Q
|
|
;
|
|
SUBINIT(C0PDUZ) ;
|
|
; SUBSCRIPTIONS MULTIPLE IN NEW PERSON
|
|
S C0PAF=113059002 ; FILE NUMBER FOR ACCOUNT FILE
|
|
S C0PSUBF=200.113059 ; SUBFILE NUMBER OF C0P SUBSCRIPTION MULTIPLE
|
|
S C0PSIEN=$O(^VA(200,C0PDUZ,"C0P","B","ERX","")) ; ERX SUBFILE IEN
|
|
Q C0PSIEN
|
|
;
|
|
HASLIC(ZDUZ) ;EXTRINSIC TO CHECK IF PERSON HAS ANY STATE LICENSES
|
|
;
|
|
Q ''$O(^VA(200,ZDUZ,"PS1","B",""))
|
|
;
|
|
GLICST(ZACCT) ;EXTRINSIC WHICH RETURNS THE POINTER TO THE STATE
|
|
;WHICH IS THE PREFERED LICENSE STATE IN THE ACCOUNT PASSED IN ZACCT
|
|
S C0PAF=113059002 ; FILE NUMBER FOR ACCOUNT FILE
|
|
Q $$GET1^DIQ(C0PAF,ZACCT_",",5,"I")
|
|
;
|
|
STLIC(ZARY,ZDUZ,ZACCT) ;ADDS SUBSCRIBER-LICENSE AND SUBSCRIBER-LICENSE-STATE
|
|
; TO ZARY, PASSED BY NAME BY LOOKING IN THE STATE LICENSE MULTIPLE
|
|
; OF THE NEW PERSON FILE FOR THE PREFERED STATE AS FOUND BY GLICST ABOVE
|
|
; FROM THE ACCOUNT NUMBER ZACCT
|
|
; IF THE PREFERED STATE IS NOT FOUND, THE FIRST STATE LISTED IS USED
|
|
I '$$HASLIC(ZDUZ) D ; NEW PERSON ZDUZ HAS NO STATE LICENSES DEFINED
|
|
. S @ZARY@("SUBSCRIBER-LICENSE")="" ; NULL LICENSE
|
|
. S @ZARY@("SUBSCRIBER-LICENSE-STATE")="" ;NULL LICENSE STATE
|
|
E D ; THERE IS A LICENSE
|
|
. N ZST,ZIEN
|
|
. S ZST=$$GLICST(ZACCT) ; GET PREFERED LICENSE STATE FROM ACCOUNT FILE
|
|
. S ZIEN=$O(^VA(200,ZDUZ,"PS1","B",ZST,"")) ;IEN OF PREFERED STATE
|
|
. I ZIEN="" D ; PREFERED STATE NOT FOUND
|
|
. . ; todo: use get1^diq here instead of looping through global
|
|
. . S ZST=$O(^VA(200,ZDUZ,"PS1","B","")) ; FIRST STATE IN MULTIPLE
|
|
. . S ZIEN=$O(^VA(200,ZDUZ,"PS1","B",ZST,"")) ; IEN OF FIRST STATE
|
|
. S @ZARY@("SUBSCRIBER-LICENSE")=$$GET1^DIQ(200.541,ZIEN_","_ZDUZ_",",1) ;LIC
|
|
. ; Try this...
|
|
. ; N ZG S ZG=$$GET1^DIQ(200.541,ZIEN_","_ZDUZ_",","LICENSING STATE:ABBREVIATION")
|
|
. N ZG S ZG=$$GET1^DIQ(200.541,ZIEN_","_ZDUZ_",",.01,"I") ;STATE POINTER
|
|
. S ZG=$$GET1^DIQ(5,ZG_",",1) ; STATE ABBREVIATION
|
|
. S @ZARY@("SUBSCRIBER-LICENSE-STATE")=ZG
|
|
Q
|
|
FAMILY(RARY,TAG,C0PDUZ) ; SETS @RARY@(TAG) TO FAMILY NAME OF DUZ
|
|
;USING KERNAL ROUTINE IN CCR PACKAGE. RARY IS PASSED BY NAME.
|
|
S @RARY@(TAG)=$$FAMILY^C0CVA200(C0PDUZ)
|
|
Q
|
|
;
|
|
GIVEN(RARY,TAG,C0PDUZ) ; SETS @RARY@(TAG) TO GIVEN NAME OF SUBSCRIBER
|
|
; USING KERNAL ROUTINE IN CCR PACKAGE. RARY IS PASSED BY NAME
|
|
S @RARY@(TAG)=$$GIVEN^C0CVA200(C0PDUZ)
|
|
Q
|
|
;
|
|
MIDDLE(RARY,TAG,C0PDUZ) ; SETS @RARY@(TAG) TO MIDDLE NAME OF SUBSCRIBER
|
|
; USING KERNAL ROUTINE IN CCR PACKAGE. RARY IS PASSED BY NAME
|
|
S @RARY@(TAG)=$$MIDDLE^C0CVA200(C0PDUZ)
|
|
Q
|
|
;
|
|
STATUS(C0PDUZ,SERVICE) ; $$ Private EP - Check Prescriber's ability to use Service
|
|
; FILEMAN USES THIS CALL. Field Status in C0P Subscription Multiple is
|
|
; + a computed field.
|
|
; gpl - changed the order of this Algorithm to do NPI and DEA last
|
|
; because they are not required for all user type and roles
|
|
; Algorithm as follows:
|
|
; 1. Check existence of DEA# or Institutional DEA + VA#
|
|
; 2. Check existence of NPI
|
|
; 3. Check for at least one license in the licensure subfile in 200
|
|
; 4. Check if a C0P Subscription for SERVICE in subfile C0P in 200 exists
|
|
; 5. Check if a C0P Subscription for points to a valid account
|
|
; 6. Check if a C0P Location is defined
|
|
; 7. Make sure that the service is not disabled for the user.
|
|
; 8. Check if the pointed to location has a phone and fax number filled in.
|
|
; -- Output --
|
|
; 1^ACTIVE --> Everything is fine
|
|
; 0^NO DEA^NO NPI^NO LICENSE^NO SUBSCRIPTION^NO SUBSCRIPTION ACCOUNT^
|
|
; + NO SUBSCSRIPTION LOCATION^SUBSCSRIBER IS DISABLED^LOCATION NOT SETUP
|
|
N RETURN
|
|
S RETURN="0" ; default case
|
|
; --> step 4, see if there's an entry for the service IEN
|
|
N C0PVARS
|
|
N SERVIEN S SERVIEN=$O(^VA(200,C0PDUZ,"C0P","B",SERVICE,""))
|
|
I $L(SERVIEN)=0 S RETURN=RETURN_"^NO SUBSCRIPTION"
|
|
D:SERVIEN
|
|
. ; --> step 5, see if the service points to a valid account
|
|
. N ACCOUNT S ACCOUNT=$$GET1^DIQ(200.113059,SERVIEN_","_C0PDUZ_",",1)
|
|
. I $L(ACCOUNT)=0 S RETURN=RETURN_"^NO SUBSCSRIPTION ACCOUNT"
|
|
. ; --> step 6, see if the service points to a valid location
|
|
. ; internal will return the IEN for use in a call below.
|
|
. N LOCATION S LOCATION=$$GET1^DIQ(200.113059,SERVIEN_","_C0PDUZ_",",2,"I")
|
|
. I $L(LOCATION)=0 S RETURN=RETURN_"^NO SUBSCSRIPTION LOCATION"
|
|
. ; --> step 7, see if the user is disabled from service
|
|
. ; Internal will return 1 or 0, 1 for yes
|
|
. N DISABLED S DISABLED=$$GET1^DIQ(200.113059,SERVIEN_","_C0PDUZ_",",3,"I")
|
|
. I +DISABLED S RETURN=RETURN_"^SUBSCSRIBER IS DISABLED"
|
|
. ; --> step 8, see if at least one set of location
|
|
. ; + phone and fax numbers have been set-up
|
|
. D:LOCATION
|
|
. . N PHONE,FAX,ARY
|
|
. . D PHONEFAX("ARY",LOCATION) ; GET THE LOCATION PHONE AND FAX
|
|
. . ;S PHONE=$$GET1^DIQ(44.113059,"1,"_LOCATION_",",1) ;this doesn't work
|
|
. . ;S FAX=$$GET1^DIQ(44.113059,"1,"_LOCATION_",",2) ; because of the 1
|
|
. . S PHONE=$G(ARY("LOCATION-PHONE")) ; PHONE IF ANY
|
|
. . S FAX=$G(ARY("LOCATION-FAX")) ; FAX IF ANY
|
|
. . I ($L(PHONE)=0)!($L(FAX)=0) S RETURN=RETURN_"^LOCATION NOT SETUP"
|
|
. D SETACCT("C0PVARS",C0PDUZ) ; INITIALIZE ARRAY
|
|
. ; --> step 1: DEA
|
|
. ;N DEA S DEA=$$DEA^XUSER("",C0PDUZ)
|
|
. ;I $L(DEA)=0 S RETURN=RETURN_"^NO DEA"
|
|
. I C0PVARS("SUBSCRIBER-DEA")="NONE" D ;
|
|
. . I C0PTYPE="P" S RETURN=RETURN_"^NO DEA" ; ONLY PRESCRIBERS NEED DEA
|
|
. ; --> step 2: NPI
|
|
. ;N NPI S NPI=$$NPI^XUSNPI("Individual_ID",C0PDUZ)
|
|
. ;I +NPI<0 S RETURN=RETURN_"^NO NPI"
|
|
. I C0PVARS("SUBSCRIBER-NPI")="NONE" D ;
|
|
. . I C0PTYPE="P" S RETURN=RETURN_"^NO NPI" ; ONLY PRESCRIBERS NEED DEA
|
|
. ; --> step 3, get first license # in license multiple
|
|
. N LIC S LIC=$$HASLIC(C0PDUZ)
|
|
. I 'LIC D ;
|
|
. . I (C0PTYPE="P")!(C0PROLE="N") S RETURN=RETURN_"^NO LICENSE" ;
|
|
. . ; PRESCRIBERS AND NURSES NEED LICENSE
|
|
; If Retrun is still 0 and nothing else, then we are good.
|
|
I RETURN="0" S RETURN="1^ACTIVE"
|
|
QUIT RETURN ; <-- END $$STATUS
|
|
;
|
|
STATUS2 ; Private Procedure for interactive check of status
|
|
N DIC,X,Y,DLAYGO,DTOUT,DUOUT
|
|
S DIC=200,DIC(0)="AEMQ",DIC("A")="Select New Person: "
|
|
D ^DIC
|
|
I Y<0 QUIT
|
|
N C0PDUZ S C0PDUZ=+Y
|
|
; Then which service are we checking for
|
|
; Grab this from the DD
|
|
N DIR,X,Y,DA,DTOUT,DUOUT,DIRUT,DIROUT
|
|
S DIR(0)="200.113059,.01"
|
|
S DIR("A")="Select Subcription Service"
|
|
D ^DIR
|
|
I $G(DIRUT) QUIT
|
|
N C0PSERV S C0PSERV=Y
|
|
N STATUS S STATUS=$$STATUS^C0PSUB(C0PDUZ,C0PSERV)
|
|
D EN^DDIOL("Status: "_$TR($P(STATUS,U,2,99),U,", "))
|
|
QUIT
|
|
;
|
|
SETACCT(C0PRTN,C0PDUZ) ; RETURN ALL SUBSCRIBER SETTINGS FOR
|
|
; GENERATING XML AND VERIFYING A COMPLETE SETUP
|
|
; ALSO, INITIALIZE NULL FIELDS WITH DEFAULTS
|
|
; C0PRTN IS PASSED BY NAME
|
|
; C0PSERV IS USUALLY "ERX" FOR EPRESCRIBING
|
|
;
|
|
;USER TYPE
|
|
;
|
|
;P LicensedPrescriber
|
|
;S Staff
|
|
;M MidlevelPrescriber
|
|
;V SupervisingDoctor
|
|
;
|
|
;USER ROLE
|
|
;
|
|
;D doctor
|
|
;N nurse
|
|
;A admin
|
|
;M manager
|
|
;SD supervisingDoctor
|
|
;MP midlevelPrescriber
|
|
;
|
|
;Requested Page
|
|
;
|
|
;C compose
|
|
;A admin
|
|
;M manager
|
|
;S status
|
|
;ME medentry
|
|
;P patientDetail
|
|
;H maintainHealthplans
|
|
;R reports-rx-daily
|
|
;
|
|
N ZI,ZJ
|
|
D SETUP^C0PMAIN() ; INITIALIZE VARIABLES
|
|
I ERXSERVIEN="" Q ; PERSON NOT SUBSCRIBED
|
|
S C0PTYPE=$$GET1^DIQ($$F200C0P^C0PMAIN(),ERXSERVIEN_","_C0PDUZ_",",4,"I")
|
|
S C0PROLE=$$GET1^DIQ($$F200C0P^C0PMAIN(),ERXSERVIEN_","_C0PDUZ_",",4.1,"I")
|
|
S C0PPAGE=$$GET1^DIQ($$F200C0P^C0PMAIN(),ERXSERVIEN_","_C0PDUZ_",",4.2,"I")
|
|
N C0PSV ; SUPERVISING DOCTOR DUZ
|
|
S C0PSV=$$GET1^DIQ($$F200C0P^C0PMAIN(),ERXSERVIEN_","_C0PDUZ_",",6,"I")
|
|
; FIELD 6 IS SUPERVISING DOCTOR. USED FOR MIDLEVEL RENEWAL PROCESSING
|
|
I $G(C0PSV)'="" D ; IF THERE IS A SUPERVISING DOCTOR
|
|
. S @C0PRTN@("SUPERVISING-DOCTOR-DUZ")=C0PSV ; RECORD FOR LATER USE
|
|
I C0PTYPE="" D ; SUBSCRIBER TYPE NOT SET
|
|
. I C0PROLE="N" S C0PTYPE="S" ; DEFAULT FOR NURSE IS STAFF
|
|
. E S C0PTYPE="P" ; ELSE DEFAULT TYPE IS LICENSEDPRESCRIBER
|
|
. K C0PFDA
|
|
. S C0PFDA($$F200C0P^C0PMAIN,ERXSERVIEN_","_C0PDUZ_",",4)=C0PTYPE ;SET TYPE
|
|
. D UPDIE ; SET THE SUBSCRIBER TYPE
|
|
I C0PROLE="" D ; SUBSCRIBER ROLE NOT SET
|
|
. I C0PTYPE="P" S C0PROLE="D" ; DOCTOR IS DEFAULT FOR LICENSED PRESCRIBER
|
|
. E S C0PROLE="N" ; ALL OTHERS SET TO NURSE
|
|
. K C0PFDA
|
|
. S C0PFDA($$F200C0P^C0PMAIN,ERXSERVIEN_","_C0PDUZ_",",4.1)=C0PROLE ;SET ROLE
|
|
. D UPDIE ; SET THE SUBSCRIBER ROLE
|
|
I C0PPAGE="" D ;
|
|
. I C0PTYPE="P" S C0PPAGE="C" ; PRESCRIBERS TO COMPOSE PAGE
|
|
. E S C0PPAGE="P" ; ALL OTHERS DEFAULT TO PATIENT DETAIL PAGE
|
|
. K C0PFDA
|
|
. S C0PFDA($$F200C0P^C0PMAIN,ERXSERVIEN_","_C0PDUZ_",",4.2)=C0PPAGE ;SET PAGE
|
|
. D UPDIE ; SET THE REQUESTED PAGE
|
|
N ZF S ZF=$$F200C0P^C0PMAIN()
|
|
S @C0PRTN@("REQUESTED-PAGE")=$$GET1^DIQ(ZF,ERXSERVIEN_","_C0PDUZ_",",4.2)
|
|
S @C0PRTN@("SUBSCRIBER-USERROLE")=$$GET1^DIQ(ZF,ERXSERVIEN_","_C0PDUZ_",",4.1)
|
|
S @C0PRTN@("SUBSCRIBER-USERTYPE")=$$GET1^DIQ(ZF,ERXSERVIEN_","_C0PDUZ_",",4)
|
|
S C0PSID=$$GET1^DIQ(ZF,ERXSERVIEN_","_C0PDUZ_",",5)
|
|
I C0PSID="" D ; SUBSCRIBER ID NOT SET
|
|
. S C0PSID=$$UUID^C0CUTIL ; SET TO RANDOM UUID
|
|
. K C0PFDA
|
|
. S C0PFDA($$F200C0P^C0PMAIN,ERXSERVIEN_","_C0PDUZ_",",5)=C0PSID ;SET SID
|
|
. D UPDIE ; SET SUBSCRIBER ID
|
|
N NPI S NPI=+$$NPI^XUSNPI("Individual_ID",C0PDUZ)
|
|
I NPI=-1 S NPI="NONE"
|
|
S @C0PRTN@("SUBSCRIBER-NPI")=NPI
|
|
N DEA S DEA=$$DEA^XUSER("",C0PDUZ)
|
|
I $L(DEA)=0 S DEA="NONE"
|
|
S @C0PRTN@("SUBSCRIBER-DEA")=DEA
|
|
;N C0PNPIF ; NPI FOR SID LEGACY FLAG - DON'T NEW THIS, IT'S NEEDED LATER
|
|
S C0PNPIF=$$GET1^DIQ(C0PAF,C0PACCT_",",8,"I") ; LEGACY FLAG TO USE NPI FOR SID
|
|
I C0PNPIF'=1 S @C0PRTN@("SUBSCRIBER-SID")=C0PSID ; IF NO FLAG, USE GUID
|
|
E D ; IF LEGACY FLAG IS ON, USE NPI FOR SID
|
|
. S @C0PRTN@("SUBSCRIBER-SID")=NPI
|
|
. I NPI="NONE" S @C0PRTN@("SUBSCRIBER-SID")="USER"_C0PDUZ ; IF NO NPI
|
|
Q
|
|
;
|
|
UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
|
|
K ZERR
|
|
D CLEAN^DILF
|
|
D UPDATE^DIE("","C0PFDA","","ZERR")
|
|
I $D(ZERR) D ERROR^C0PMAIN(",U113059008,",$ST($ST,"PLACE"),"ERX-UPDIE-FAIL","Fileman Data Update Failure") QUIT
|
|
K C0PFDA
|
|
Q
|