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