| [1595] | 1 | C0PSUB ; ERX/GPL - ERX SUBSCRIBER utilities; 5/8/12 9:51pm
|
|---|
| 2 | ;;1.0;C0P;;Apr 25, 2012;Build 103
|
|---|
| 3 | ;Copyright 2009 George Lilly. Licensed under the terms of the GNU
|
|---|
| 4 | ;General Public License See attached copy of the License.
|
|---|
| 5 | ;
|
|---|
| 6 | ;This program is free software; you can redistribute it and/or modify
|
|---|
| 7 | ;it under the terms of the GNU General Public License as published by
|
|---|
| 8 | ;the Free Software Foundation; either version 2 of the License, or
|
|---|
| 9 | ;(at your option) any later version.
|
|---|
| 10 | ;
|
|---|
| 11 | ;This program is distributed in the hope that it will be useful,
|
|---|
| 12 | ;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|---|
| 13 | ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|---|
| 14 | ;GNU General Public License for more details.
|
|---|
| 15 | ;
|
|---|
| 16 | ;You should have received a copy of the GNU General Public License along
|
|---|
| 17 | ;with this program; if not, write to the Free Software Foundation, Inc.,
|
|---|
| 18 | ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|---|
| 19 | ;
|
|---|
| 20 | QUIT
|
|---|
| 21 | EN(INARY,C0PDUZ) ; creates the array inary passed by name for subscriber
|
|---|
| 22 | ; variables, mostly from the new person file
|
|---|
| 23 | ; SUBSCRIBER-FAMILY-NAME
|
|---|
| 24 | ; SUBSCRIBER-GIVEN-NAME
|
|---|
| 25 | ; SUBSCRIBER-MIDDLE-NAME
|
|---|
| 26 | ; LOCATION-PHONE
|
|---|
| 27 | ; LOCATION-FAX
|
|---|
| 28 | ; ACCOUNT-PHONE
|
|---|
| 29 | ; ACCOUNT-FAX
|
|---|
| 30 | ; LOCATION-ADDRESS1
|
|---|
| 31 | ; LOCATION-ADDRESS2
|
|---|
| 32 | ; LOCATION-CITY
|
|---|
| 33 | ; LOCATION-ZIP
|
|---|
| 34 | ; LOCATION-ZIP4
|
|---|
| 35 | ; LOCATION-STATE
|
|---|
| 36 | ; SUBSCRIBER-LICENSE
|
|---|
| 37 | ; SUBSCRIBER-LICENSE-STATE
|
|---|
| 38 | ; SUBSCRIBER-USERROLE
|
|---|
| 39 | ; SUBSCRIBER-USER
|
|---|
| 40 | ; ACCOUNT-COUNTRY
|
|---|
| 41 | ; ACCOUNT-ADDRESS-ZIP4
|
|---|
| 42 | ; LOCATION-COUNTRY
|
|---|
| 43 | ; REQUESTED-PAGE
|
|---|
| 44 | D FAMILY(INARY,"SUBCRIBER-FAMILY-NAME",C0PDUZ)
|
|---|
| 45 | D GIVEN(INARY,"SUBCRIBER-GIVEN-NAME",C0PDUZ)
|
|---|
| 46 | D MIDDLE(INARY,"SUBCRIBER-MIDDLE-NAME",C0PDUZ)
|
|---|
| 47 | D PHONEFAX(INARY,C0PLOC) ; SETS "LOCATION-PHONE" AND "LOCATION-FAX"
|
|---|
| 48 | D ACTPHFAX(INARY,C0PACCT) ;SETS "ACCOUNT-PHONE" AND "ACCOUNT-FAX"
|
|---|
| 49 | D GETLOC(INARY,C0PLOC) ;SETS "LOCATION-" VARIABLES (SEE ROUTINE FOR LIST)
|
|---|
| 50 | D STLIC(INARY,C0PDUZ,C0PACCT) ;LICENSE AND LICENSE STATE
|
|---|
| 51 | S C0PAF=113059002 ; FILE NUMBER FOR ACCOUNT FILE
|
|---|
| 52 | S @INARY@("ACCOUNT-PARTNERNAME")=$$GET1^DIQ(C0PAF,C0PACCT_",",3.1) ;
|
|---|
| 53 | I @INARY@("ACCOUNT-PARTNERNAME")="" S @INARY@("ACCOUNT-PARTNERNAME")="demo"
|
|---|
| 54 | ; todo: NPs, PAs, assistants need different roles
|
|---|
| 55 | D SETACCT(INARY,C0PDUZ) ; SET SUBSCRIBER VARIABLES
|
|---|
| 56 | ;S @INARY@("SUBSCRIBER-USERROLE")="doctor" ; BASE CASE ACCESS
|
|---|
| 57 | ;S @INARY@("SUBSCRIBER-USER")="LicensedPrescriber" ; BASE CASE ACCESS
|
|---|
| 58 | S @INARY@("ACCOUNT-COUNTRY")="US" ;BASE CASE ACCESS
|
|---|
| 59 | S @INARY@("ACCOUNT-ADDRESS-ZIP4")="" ;DON'T HAVE THIS
|
|---|
| 60 | S @INARY@("LOCATION-COUNTRY")="US" ; NOT IN FILE
|
|---|
| 61 | S @INARY@("REQUESTED-PAGE")="compose" ; DEFAULT PAG
|
|---|
| 62 | S @INARY@("ACCOUNT-ACCOUNTID")=$$GET1^DIQ(C0PAF,C0PACCT_",",2.4)
|
|---|
| 63 | I @INARY@("ACCOUNT-ACCOUNTID")="" S @INARY@("ACCOUNT-ACCOUNTID")="demo"
|
|---|
| 64 | S @INARY@("ACCOUNT-NAME")=$$GET1^DIQ(C0PAF,C0PACCT_",",3)
|
|---|
| 65 | I @INARY@("ACCOUNT-NAME")="" S @INARY@("ACCOUNT-NAME")="demo"
|
|---|
| 66 | S @INARY@("ACCOUNT-PASSWORD")=$$GET1^DIQ(C0PAF,C0PACCT_",",3.2)
|
|---|
| 67 | I @INARY@("ACCOUNT-PASSWORD")="" S @INARY@("ACCOUNT-PASSWORD")="demo"
|
|---|
| 68 | ;S @INARY@("SUBSCRIBER-USERTYPE")="Doctor" ; IS RESET LATER
|
|---|
| 69 | ;S @INARY@("SUBSCRIBER-USERID")="demo" ; IS RESET LATER
|
|---|
| 70 | ;N NPI S NPI=$$NPI^XUSNPI("Individual_ID",C0PDUZ)
|
|---|
| 71 | ;S @INARY@("SUBSCRIBER-SID")=+NPI ; FOR NOW
|
|---|
| 72 | ;
|
|---|
| 73 | Q
|
|---|
| 74 | ;
|
|---|
| 75 | ACTPHFAX(RARY,ZACCT) ;SET ACCOUNT PHONE AND FAX FROM ACCOUNT FILE
|
|---|
| 76 | ; ZACCT IS A POINTER TO THE ACCOUNT FILE
|
|---|
| 77 | S C0PAF=113059002 ; FILE NUMBER FOR ACCOUNT FILE
|
|---|
| 78 | S @RARY@("ACCOUNT-PHONE")=$$GET1^DIQ(C0PAF,ZACCT_",",2.2) ;PHONE NUMBER
|
|---|
| 79 | S @RARY@("ACCOUNT-FAX")=$$GET1^DIQ(C0PAF,ZACCT_",",2.1) ; FAX NUMBER
|
|---|
| 80 | Q
|
|---|
| 81 | ;
|
|---|
| 82 | PHONEFAX(RARY,C0PLOC) ; SET LOCATION PHONE AND FAX INTO THE RETURN ARRAY
|
|---|
| 83 | N PRIORITY,LOCIEN
|
|---|
| 84 | S PRIORITY=$O(^SC(C0PLOC,"C0P","PRIORITY",""))
|
|---|
| 85 | I PRIORITY="" W "NO LOCATION PHONE SET",! Q
|
|---|
| 86 | S LOCIEN=$O(^SC(C0PLOC,"C0P","PRIORITY",PRIORITY,""))
|
|---|
| 87 | S C0PLOCF=44.113059
|
|---|
| 88 | S @RARY@("LOCATION-PHONE")=$$GET1^DIQ(C0PLOCF,LOCIEN_","_C0PLOC_",",1)
|
|---|
| 89 | S @RARY@("LOCATION-FAX")=$$GET1^DIQ(C0PLOCF,LOCIEN_","_C0PLOC_",",2)
|
|---|
| 90 | Q
|
|---|
| 91 | ;
|
|---|
| 92 | GETLOC(RARY,ZLOC) ; GETS LOCATIONS VARIABLE FROM POINTER ZLOC
|
|---|
| 93 | ; TO THE HOSPITAL LOCATION FILE
|
|---|
| 94 | ; THE LOCATION ADDRESS IS FOUND IN NEW FIELDS IN THE HOSPITAL LOCATION FILE 44
|
|---|
| 95 | ; IF THESE ARE NULL, THE ADDRESS WILL BE TAKEN FROM THE INSTITUTION FILE,
|
|---|
| 96 | ; WHICH IS POINTED TO BY THE FILE 44
|
|---|
| 97 | ;
|
|---|
| 98 | S @RARY@("LOCATION-SITEID")="LOCATION_"_ZLOC ; SITE ID
|
|---|
| 99 | S @RARY@("LOCATION-ADDRESS1")=$$GET1^DIQ(44,ZLOC_",",113059111) ;ADDR1
|
|---|
| 100 | I @RARY@("LOCATION-ADDRESS1")'="" D ; ADDRESS PRESENT IN 44
|
|---|
| 101 | . S @RARY@("LOCATION-ADDRESS2")=$$GET1^DIQ(44,ZLOC_",",113059112) ;ADDR2
|
|---|
| 102 | . S @RARY@("LOCATION-CITY")=$$GET1^DIQ(44,ZLOC_",",113059114) ;CITY
|
|---|
| 103 | . S @RARY@("LOCATION-ZIP")=$$GET1^DIQ(44,ZLOC_",",113059116) ;ZIP
|
|---|
| 104 | . S @RARY@("LOCATION-ZIP4")="" ;NO ZIP4
|
|---|
| 105 | . N ZJ
|
|---|
| 106 | . S ZJ=$$GET1^DIQ(44,ZLOC_",",113059115,"I") ;STATE
|
|---|
| 107 | . S @RARY@("LOCATION-STATE")=$$GET1^DIQ(5,ZJ_",",1) ;STATE ABBREVIATION
|
|---|
| 108 | E D ; TAKE THE ADDRESS FROM THE INSTITUTION FILE
|
|---|
| 109 | . N ZI
|
|---|
| 110 | . S ZI=$$GET1^DIQ(44,ZLOC_",",3,"I") ; POINTER TO INSTITUTION FILE
|
|---|
| 111 | . S @RARY@("LOCATION-ADDRESS1")=$$GET1^DIQ(4,ZI_",",1.01) ;ADDR1
|
|---|
| 112 | . S @RARY@("LOCATION-ADDRESS2")=$$GET1^DIQ(4,ZI_",",1.02) ;ADDR2
|
|---|
| 113 | . S @RARY@("LOCATION-CITY")=$$GET1^DIQ(4,ZI_",",1.03) ;CITY
|
|---|
| 114 | . S @RARY@("LOCATION-ZIP")=$$GET1^DIQ(4,ZI_",",1.04) ;ZIP
|
|---|
| 115 | . S @RARY@("LOCATION-ZIP4")="" ;NO ZIP4
|
|---|
| 116 | . N ZJ
|
|---|
| 117 | . S ZJ=$$GET1^DIQ(4,ZI_",",.02,"I") ;STATE
|
|---|
| 118 | . S @RARY@("LOCATION-STATE")=$$GET1^DIQ(5,ZJ_",",1) ;STATE ABBREVIATION
|
|---|
| 119 | Q
|
|---|
| 120 | ;
|
|---|
| 121 | SUBINIT(C0PDUZ) ;
|
|---|
| 122 | ; SUBSCRIPTIONS MULTIPLE IN NEW PERSON
|
|---|
| 123 | S C0PAF=113059002 ; FILE NUMBER FOR ACCOUNT FILE
|
|---|
| 124 | S C0PSUBF=200.113059 ; SUBFILE NUMBER OF C0P SUBSCRIPTION MULTIPLE
|
|---|
| 125 | S C0PSIEN=$O(^VA(200,C0PDUZ,"C0P","B","ERX","")) ; ERX SUBFILE IEN
|
|---|
| 126 | Q C0PSIEN
|
|---|
| 127 | ;
|
|---|
| 128 | HASLIC(ZDUZ) ;EXTRINSIC TO CHECK IF PERSON HAS ANY STATE LICENSES
|
|---|
| 129 | ;
|
|---|
| 130 | Q ''$O(^VA(200,ZDUZ,"PS1","B",""))
|
|---|
| 131 | ;
|
|---|
| 132 | GLICST(ZACCT) ;EXTRINSIC WHICH RETURNS THE POINTER TO THE STATE
|
|---|
| 133 | ;WHICH IS THE PREFERED LICENSE STATE IN THE ACCOUNT PASSED IN ZACCT
|
|---|
| 134 | S C0PAF=113059002 ; FILE NUMBER FOR ACCOUNT FILE
|
|---|
| 135 | Q $$GET1^DIQ(C0PAF,ZACCT_",",5,"I")
|
|---|
| 136 | ;
|
|---|
| 137 | STLIC(ZARY,ZDUZ,ZACCT) ;ADDS SUBSCRIBER-LICENSE AND SUBSCRIBER-LICENSE-STATE
|
|---|
| 138 | ; TO ZARY, PASSED BY NAME BY LOOKING IN THE STATE LICENSE MULTIPLE
|
|---|
| 139 | ; OF THE NEW PERSON FILE FOR THE PREFERED STATE AS FOUND BY GLICST ABOVE
|
|---|
| 140 | ; FROM THE ACCOUNT NUMBER ZACCT
|
|---|
| 141 | ; IF THE PREFERED STATE IS NOT FOUND, THE FIRST STATE LISTED IS USED
|
|---|
| 142 | I '$$HASLIC(ZDUZ) D ; NEW PERSON ZDUZ HAS NO STATE LICENSES DEFINED
|
|---|
| 143 | . S @ZARY@("SUBSCRIBER-LICENSE")="" ; NULL LICENSE
|
|---|
| 144 | . S @ZARY@("SUBSCRIBER-LICENSE-STATE")="" ;NULL LICENSE STATE
|
|---|
| 145 | E D ; THERE IS A LICENSE
|
|---|
| 146 | . N ZST,ZIEN
|
|---|
| 147 | . S ZST=$$GLICST(ZACCT) ; GET PREFERED LICENSE STATE FROM ACCOUNT FILE
|
|---|
| 148 | . S ZIEN=$O(^VA(200,ZDUZ,"PS1","B",ZST,"")) ;IEN OF PREFERED STATE
|
|---|
| 149 | . I ZIEN="" D ; PREFERED STATE NOT FOUND
|
|---|
| 150 | . . ; todo: use get1^diq here instead of looping through global
|
|---|
| 151 | . . S ZST=$O(^VA(200,ZDUZ,"PS1","B","")) ; FIRST STATE IN MULTIPLE
|
|---|
| 152 | . . S ZIEN=$O(^VA(200,ZDUZ,"PS1","B",ZST,"")) ; IEN OF FIRST STATE
|
|---|
| 153 | . S @ZARY@("SUBSCRIBER-LICENSE")=$$GET1^DIQ(200.541,ZIEN_","_ZDUZ_",",1) ;LIC
|
|---|
| 154 | . ; Try this...
|
|---|
| 155 | . ; N ZG S ZG=$$GET1^DIQ(200.541,ZIEN_","_ZDUZ_",","LICENSING STATE:ABBREVIATION")
|
|---|
| 156 | . N ZG S ZG=$$GET1^DIQ(200.541,ZIEN_","_ZDUZ_",",.01,"I") ;STATE POINTER
|
|---|
| 157 | . S ZG=$$GET1^DIQ(5,ZG_",",1) ; STATE ABBREVIATION
|
|---|
| 158 | . S @ZARY@("SUBSCRIBER-LICENSE-STATE")=ZG
|
|---|
| 159 | Q
|
|---|
| 160 | FAMILY(RARY,TAG,C0PDUZ) ; SETS @RARY@(TAG) TO FAMILY NAME OF DUZ
|
|---|
| 161 | ;USING KERNAL ROUTINE IN CCR PACKAGE. RARY IS PASSED BY NAME.
|
|---|
| 162 | S @RARY@(TAG)=$$FAMILY^C0CVA200(C0PDUZ)
|
|---|
| 163 | Q
|
|---|
| 164 | ;
|
|---|
| 165 | GIVEN(RARY,TAG,C0PDUZ) ; SETS @RARY@(TAG) TO GIVEN NAME OF SUBSCRIBER
|
|---|
| 166 | ; USING KERNAL ROUTINE IN CCR PACKAGE. RARY IS PASSED BY NAME
|
|---|
| 167 | S @RARY@(TAG)=$$GIVEN^C0CVA200(C0PDUZ)
|
|---|
| 168 | Q
|
|---|
| 169 | ;
|
|---|
| 170 | MIDDLE(RARY,TAG,C0PDUZ) ; SETS @RARY@(TAG) TO MIDDLE NAME OF SUBSCRIBER
|
|---|
| 171 | ; USING KERNAL ROUTINE IN CCR PACKAGE. RARY IS PASSED BY NAME
|
|---|
| 172 | S @RARY@(TAG)=$$MIDDLE^C0CVA200(C0PDUZ)
|
|---|
| 173 | Q
|
|---|
| 174 | ;
|
|---|
| 175 | STATUS(C0PDUZ,SERVICE) ; $$ Private EP - Check Prescriber's ability to use Service
|
|---|
| 176 | ; FILEMAN USES THIS CALL. Field Status in C0P Subscription Multiple is
|
|---|
| 177 | ; + a computed field.
|
|---|
| 178 | ; gpl - changed the order of this Algorithm to do NPI and DEA last
|
|---|
| 179 | ; because they are not required for all user type and roles
|
|---|
| 180 | ; Algorithm as follows:
|
|---|
| 181 | ; 1. Check existence of DEA# or Institutional DEA + VA#
|
|---|
| 182 | ; 2. Check existence of NPI
|
|---|
| 183 | ; 3. Check for at least one license in the licensure subfile in 200
|
|---|
| 184 | ; 4. Check if a C0P Subscription for SERVICE in subfile C0P in 200 exists
|
|---|
| 185 | ; 5. Check if a C0P Subscription for points to a valid account
|
|---|
| 186 | ; 6. Check if a C0P Location is defined
|
|---|
| 187 | ; 7. Make sure that the service is not disabled for the user.
|
|---|
| 188 | ; 8. Check if the pointed to location has a phone and fax number filled in.
|
|---|
| 189 | ; -- Output --
|
|---|
| 190 | ; 1^ACTIVE --> Everything is fine
|
|---|
| 191 | ; 0^NO DEA^NO NPI^NO LICENSE^NO SUBSCRIPTION^NO SUBSCRIPTION ACCOUNT^
|
|---|
| 192 | ; + NO SUBSCSRIPTION LOCATION^SUBSCSRIBER IS DISABLED^LOCATION NOT SETUP
|
|---|
| 193 | N RETURN
|
|---|
| 194 | S RETURN="0" ; default case
|
|---|
| 195 | ; --> step 4, see if there's an entry for the service IEN
|
|---|
| 196 | N C0PVARS
|
|---|
| 197 | N SERVIEN S SERVIEN=$O(^VA(200,C0PDUZ,"C0P","B",SERVICE,""))
|
|---|
| 198 | I $L(SERVIEN)=0 S RETURN=RETURN_"^NO SUBSCRIPTION"
|
|---|
| 199 | D:SERVIEN
|
|---|
| 200 | . ; --> step 5, see if the service points to a valid account
|
|---|
| 201 | . N ACCOUNT S ACCOUNT=$$GET1^DIQ(200.113059,SERVIEN_","_C0PDUZ_",",1)
|
|---|
| 202 | . I $L(ACCOUNT)=0 S RETURN=RETURN_"^NO SUBSCSRIPTION ACCOUNT"
|
|---|
| 203 | . ; --> step 6, see if the service points to a valid location
|
|---|
| 204 | . ; internal will return the IEN for use in a call below.
|
|---|
| 205 | . N LOCATION S LOCATION=$$GET1^DIQ(200.113059,SERVIEN_","_C0PDUZ_",",2,"I")
|
|---|
| 206 | . I $L(LOCATION)=0 S RETURN=RETURN_"^NO SUBSCSRIPTION LOCATION"
|
|---|
| 207 | . ; --> step 7, see if the user is disabled from service
|
|---|
| 208 | . ; Internal will return 1 or 0, 1 for yes
|
|---|
| 209 | . N DISABLED S DISABLED=$$GET1^DIQ(200.113059,SERVIEN_","_C0PDUZ_",",3,"I")
|
|---|
| 210 | . I +DISABLED S RETURN=RETURN_"^SUBSCSRIBER IS DISABLED"
|
|---|
| 211 | . ; --> step 8, see if at least one set of location
|
|---|
| 212 | . ; + phone and fax numbers have been set-up
|
|---|
| 213 | . D:LOCATION
|
|---|
| 214 | . . N PHONE,FAX,ARY
|
|---|
| 215 | . . D PHONEFAX("ARY",LOCATION) ; GET THE LOCATION PHONE AND FAX
|
|---|
| 216 | . . ;S PHONE=$$GET1^DIQ(44.113059,"1,"_LOCATION_",",1) ;this doesn't work
|
|---|
| 217 | . . ;S FAX=$$GET1^DIQ(44.113059,"1,"_LOCATION_",",2) ; because of the 1
|
|---|
| 218 | . . S PHONE=$G(ARY("LOCATION-PHONE")) ; PHONE IF ANY
|
|---|
| 219 | . . S FAX=$G(ARY("LOCATION-FAX")) ; FAX IF ANY
|
|---|
| 220 | . . I ($L(PHONE)=0)!($L(FAX)=0) S RETURN=RETURN_"^LOCATION NOT SETUP"
|
|---|
| 221 | . D SETACCT("C0PVARS",C0PDUZ) ; INITIALIZE ARRAY
|
|---|
| 222 | . ; --> step 1: DEA
|
|---|
| 223 | . ;N DEA S DEA=$$DEA^XUSER("",C0PDUZ)
|
|---|
| 224 | . ;I $L(DEA)=0 S RETURN=RETURN_"^NO DEA"
|
|---|
| 225 | . I C0PVARS("SUBSCRIBER-DEA")="NONE" D ;
|
|---|
| 226 | . . I C0PTYPE="P" S RETURN=RETURN_"^NO DEA" ; ONLY PRESCRIBERS NEED DEA
|
|---|
| 227 | . ; --> step 2: NPI
|
|---|
| 228 | . ;N NPI S NPI=$$NPI^XUSNPI("Individual_ID",C0PDUZ)
|
|---|
| 229 | . ;I +NPI<0 S RETURN=RETURN_"^NO NPI"
|
|---|
| 230 | . I C0PVARS("SUBSCRIBER-NPI")="NONE" D ;
|
|---|
| 231 | . . I C0PTYPE="P" S RETURN=RETURN_"^NO NPI" ; ONLY PRESCRIBERS NEED DEA
|
|---|
| 232 | . ; --> step 3, get first license # in license multiple
|
|---|
| 233 | . N LIC S LIC=$$HASLIC(C0PDUZ)
|
|---|
| 234 | . I 'LIC D ;
|
|---|
| 235 | . . I (C0PTYPE="P")!(C0PROLE="N") S RETURN=RETURN_"^NO LICENSE" ;
|
|---|
| 236 | . . ; PRESCRIBERS AND NURSES NEED LICENSE
|
|---|
| 237 | ; If Retrun is still 0 and nothing else, then we are good.
|
|---|
| 238 | I RETURN="0" S RETURN="1^ACTIVE"
|
|---|
| 239 | QUIT RETURN ; <-- END $$STATUS
|
|---|
| 240 | ;
|
|---|
| 241 | STATUS2 ; Private Procedure for interactive check of status
|
|---|
| 242 | N DIC,X,Y,DLAYGO,DTOUT,DUOUT
|
|---|
| 243 | S DIC=200,DIC(0)="AEMQ",DIC("A")="Select New Person: "
|
|---|
| 244 | D ^DIC
|
|---|
| 245 | I Y<0 QUIT
|
|---|
| 246 | N C0PDUZ S C0PDUZ=+Y
|
|---|
| 247 | ; Then which service are we checking for
|
|---|
| 248 | ; Grab this from the DD
|
|---|
| 249 | N DIR,X,Y,DA,DTOUT,DUOUT,DIRUT,DIROUT
|
|---|
| 250 | S DIR(0)="200.113059,.01"
|
|---|
| 251 | S DIR("A")="Select Subcription Service"
|
|---|
| 252 | D ^DIR
|
|---|
| 253 | I $G(DIRUT) QUIT
|
|---|
| 254 | N C0PSERV S C0PSERV=Y
|
|---|
| 255 | N STATUS S STATUS=$$STATUS^C0PSUB(C0PDUZ,C0PSERV)
|
|---|
| 256 | D EN^DDIOL("Status: "_$TR($P(STATUS,U,2,99),U,", "))
|
|---|
| 257 | QUIT
|
|---|
| 258 | ;
|
|---|
| 259 | SETACCT(C0PRTN,C0PDUZ) ; RETURN ALL SUBSCRIBER SETTINGS FOR
|
|---|
| 260 | ; GENERATING XML AND VERIFYING A COMPLETE SETUP
|
|---|
| 261 | ; ALSO, INITIALIZE NULL FIELDS WITH DEFAULTS
|
|---|
| 262 | ; C0PRTN IS PASSED BY NAME
|
|---|
| 263 | ; C0PSERV IS USUALLY "ERX" FOR EPRESCRIBING
|
|---|
| 264 | ;
|
|---|
| 265 | ;USER TYPE
|
|---|
| 266 | ;
|
|---|
| 267 | ;P LicensedPrescriber
|
|---|
| 268 | ;S Staff
|
|---|
| 269 | ;M MidlevelPrescriber
|
|---|
| 270 | ;V SupervisingDoctor
|
|---|
| 271 | ;
|
|---|
| 272 | ;USER ROLE
|
|---|
| 273 | ;
|
|---|
| 274 | ;D doctor
|
|---|
| 275 | ;N nurse
|
|---|
| 276 | ;A admin
|
|---|
| 277 | ;M manager
|
|---|
| 278 | ;SD supervisingDoctor
|
|---|
| 279 | ;MP midlevelPrescriber
|
|---|
| 280 | ;
|
|---|
| 281 | ;Requested Page
|
|---|
| 282 | ;
|
|---|
| 283 | ;C compose
|
|---|
| 284 | ;A admin
|
|---|
| 285 | ;M manager
|
|---|
| 286 | ;S status
|
|---|
| 287 | ;ME medentry
|
|---|
| 288 | ;P patientDetail
|
|---|
| 289 | ;H maintainHealthplans
|
|---|
| 290 | ;R reports-rx-daily
|
|---|
| 291 | ;
|
|---|
| 292 | N ZI,ZJ
|
|---|
| 293 | D SETUP^C0PMAIN() ; INITIALIZE VARIABLES
|
|---|
| 294 | I ERXSERVIEN="" Q ; PERSON NOT SUBSCRIBED
|
|---|
| 295 | S C0PTYPE=$$GET1^DIQ($$F200C0P^C0PMAIN(),ERXSERVIEN_","_C0PDUZ_",",4,"I")
|
|---|
| 296 | S C0PROLE=$$GET1^DIQ($$F200C0P^C0PMAIN(),ERXSERVIEN_","_C0PDUZ_",",4.1,"I")
|
|---|
| 297 | S C0PPAGE=$$GET1^DIQ($$F200C0P^C0PMAIN(),ERXSERVIEN_","_C0PDUZ_",",4.2,"I")
|
|---|
| 298 | N C0PSV ; SUPERVISING DOCTOR DUZ
|
|---|
| 299 | S C0PSV=$$GET1^DIQ($$F200C0P^C0PMAIN(),ERXSERVIEN_","_C0PDUZ_",",6,"I")
|
|---|
| 300 | ; FIELD 6 IS SUPERVISING DOCTOR. USED FOR MIDLEVEL RENEWAL PROCESSING
|
|---|
| 301 | I $G(C0PSV)'="" D ; IF THERE IS A SUPERVISING DOCTOR
|
|---|
| 302 | . S @C0PRTN@("SUPERVISING-DOCTOR-DUZ")=C0PSV ; RECORD FOR LATER USE
|
|---|
| 303 | I C0PTYPE="" D ; SUBSCRIBER TYPE NOT SET
|
|---|
| 304 | . I C0PROLE="N" S C0PTYPE="S" ; DEFAULT FOR NURSE IS STAFF
|
|---|
| 305 | . E S C0PTYPE="P" ; ELSE DEFAULT TYPE IS LICENSEDPRESCRIBER
|
|---|
| 306 | . K C0PFDA
|
|---|
| 307 | . S C0PFDA($$F200C0P^C0PMAIN,ERXSERVIEN_","_C0PDUZ_",",4)=C0PTYPE ;SET TYPE
|
|---|
| 308 | . D UPDIE ; SET THE SUBSCRIBER TYPE
|
|---|
| 309 | I C0PROLE="" D ; SUBSCRIBER ROLE NOT SET
|
|---|
| 310 | . I C0PTYPE="P" S C0PROLE="D" ; DOCTOR IS DEFAULT FOR LICENSED PRESCRIBER
|
|---|
| 311 | . E S C0PROLE="N" ; ALL OTHERS SET TO NURSE
|
|---|
| 312 | . K C0PFDA
|
|---|
| 313 | . S C0PFDA($$F200C0P^C0PMAIN,ERXSERVIEN_","_C0PDUZ_",",4.1)=C0PROLE ;SET ROLE
|
|---|
| 314 | . D UPDIE ; SET THE SUBSCRIBER ROLE
|
|---|
| 315 | I C0PPAGE="" D ;
|
|---|
| 316 | . I C0PTYPE="P" S C0PPAGE="C" ; PRESCRIBERS TO COMPOSE PAGE
|
|---|
| 317 | . E S C0PPAGE="P" ; ALL OTHERS DEFAULT TO PATIENT DETAIL PAGE
|
|---|
| 318 | . K C0PFDA
|
|---|
| 319 | . S C0PFDA($$F200C0P^C0PMAIN,ERXSERVIEN_","_C0PDUZ_",",4.2)=C0PPAGE ;SET PAGE
|
|---|
| 320 | . D UPDIE ; SET THE REQUESTED PAGE
|
|---|
| 321 | N ZF S ZF=$$F200C0P^C0PMAIN()
|
|---|
| 322 | S @C0PRTN@("REQUESTED-PAGE")=$$GET1^DIQ(ZF,ERXSERVIEN_","_C0PDUZ_",",4.2)
|
|---|
| 323 | S @C0PRTN@("SUBSCRIBER-USERROLE")=$$GET1^DIQ(ZF,ERXSERVIEN_","_C0PDUZ_",",4.1)
|
|---|
| 324 | S @C0PRTN@("SUBSCRIBER-USERTYPE")=$$GET1^DIQ(ZF,ERXSERVIEN_","_C0PDUZ_",",4)
|
|---|
| 325 | S C0PSID=$$GET1^DIQ(ZF,ERXSERVIEN_","_C0PDUZ_",",5)
|
|---|
| 326 | I C0PSID="" D ; SUBSCRIBER ID NOT SET
|
|---|
| 327 | . S C0PSID=$$UUID^C0CUTIL ; SET TO RANDOM UUID
|
|---|
| 328 | . K C0PFDA
|
|---|
| 329 | . S C0PFDA($$F200C0P^C0PMAIN,ERXSERVIEN_","_C0PDUZ_",",5)=C0PSID ;SET SID
|
|---|
| 330 | . D UPDIE ; SET SUBSCRIBER ID
|
|---|
| 331 | N NPI S NPI=+$$NPI^XUSNPI("Individual_ID",C0PDUZ)
|
|---|
| 332 | I NPI=-1 S NPI="NONE"
|
|---|
| 333 | S @C0PRTN@("SUBSCRIBER-NPI")=NPI
|
|---|
| 334 | N DEA S DEA=$$DEA^XUSER("",C0PDUZ)
|
|---|
| 335 | I $L(DEA)=0 S DEA="NONE"
|
|---|
| 336 | S @C0PRTN@("SUBSCRIBER-DEA")=DEA
|
|---|
| 337 | ;N C0PNPIF ; NPI FOR SID LEGACY FLAG - DON'T NEW THIS, IT'S NEEDED LATER
|
|---|
| 338 | S C0PNPIF=$$GET1^DIQ(C0PAF,C0PACCT_",",8,"I") ; LEGACY FLAG TO USE NPI FOR SID
|
|---|
| 339 | I C0PNPIF'=1 S @C0PRTN@("SUBSCRIBER-SID")=C0PSID ; IF NO FLAG, USE GUID
|
|---|
| 340 | E D ; IF LEGACY FLAG IS ON, USE NPI FOR SID
|
|---|
| 341 | . S @C0PRTN@("SUBSCRIBER-SID")=NPI
|
|---|
| 342 | . I NPI="NONE" S @C0PRTN@("SUBSCRIBER-SID")="USER"_C0PDUZ ; IF NO NPI
|
|---|
| 343 | Q
|
|---|
| 344 | ;
|
|---|
| 345 | UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
|
|---|
| 346 | K ZERR
|
|---|
| 347 | D CLEAN^DILF
|
|---|
| 348 | D UPDATE^DIE("","C0PFDA","","ZERR")
|
|---|
| 349 | I $D(ZERR) D ERROR^C0PMAIN(",U113059008,",$ST($ST,"PLACE"),"ERX-UPDIE-FAIL","Fileman Data Update Failure") QUIT
|
|---|
| 350 | K C0PFDA
|
|---|
| 351 | Q
|
|---|
