BEDDPREF ;VNGT/HS/BEE-BEDD Utility Routine - Cache Calls ; 08 Nov 2011 12:00 PM
;;2.0;IHS EMERGENCY DEPT DASHBOARD;**1**;Apr 02, 2014
;
;New for BEDD*2.0*1
;
;This routine is included in the BEDD XML 2.0 Patch 1 install and is not in the KIDS
;
Q
;
WACCESS(DUZ) ;EP - Return whether user can edit the Whiteboard settings
;
I +$G(DUZ)=0 Q 0
I $$HASKEY^CIAVCXUS("BEDDZWHITEBOARD",DUZ) Q 1
Q 0
;
LUPREF(SITE,PDUZ) ;EP - Return user preferences for a site/user
;
NEW UPIEN,UPREF,RESULT
;
I $G(SITE)="" Q "0^0^0^^^" ;No site
I $G(PDUZ)="" Q "0^0^0^^^" ;No DUZ
;
;Look for existing entry
S UPIEN=$O(^BEDD.EDUserPreferencesI("DUZSiteIdx"," "_PDUZ," "_SITE,""))
;
;Entry exists
S RESULT="0^0^0^^^" I UPIEN]"" D
. S UPREF=##class(BEDD.EDUserPreferences).%OpenId(UPIEN)
. S $P(RESULT,"^")=$S(UPREF.HideDOB]"":UPREF.HideDOB,1:0)
. S $P(RESULT,"^",2)=$S(UPREF.HideComp]"":UPREF.HideComp,1:0)
. S $P(RESULT,"^",3)=$S(UPREF.HideSex]"":UPREF.HideSex,1:0)
. S $P(RESULT,"^",4)=$S(UPREF.PatientNameFormat]"":UPREF.PatientNameFormat,1:"FLFF")
. S $P(RESULT,"^",5)=UPREF.UserName
. S $P(RESULT,"^",6)=PDUZ
S UPREF=""
;
Q RESULT
;
CHECKWB(ACVC) ;Check Whiteboard login credentials
;
NEW AC,VC,SUCCESS,SiteIEN,SITE
;
S AC=$P(ACVC,";")
S VC=$P(ACVC,";",2)
;
;Check Access
I AC'="Whiteboard" Q 0
;
;Locate verify on file
S SiteIEN=$O(^BEDD.EDSYSTEMI("SiteIdx"," 999999",""))
I SiteIEN]"",'$D(^BEDD.EDSYSTEMD(SiteIEN)) D
. K ^BEDD.EDSYSTEMI("SiteIdx"," 999999")
. S SiteIEN=""
I SiteIEN="" Q 0
S SITE=##CLASS(BEDD.EDSYSTEM).%OpenId(SiteIEN)
I VC'=SITE.Verify Q 0
;
Q 1
;
WBPREF(WVERIFY) ;EP - Save Whiteboard Information
;
;I $G(WVERIFY)="" Q 0
;
NEW SiteIEN,EDSYS,STS
;
;Look for Whiteboard Entry
S SiteIEN=$O(^BEDD.EDSYSTEMI("SiteIdx"," 999999",""))
I SiteIEN]"",'$D(^BEDD.EDSYSTEMD(SiteIEN)) D
. K ^BEDD.EDSYSTEMI("SiteIdx"," 999999")
. S SiteIEN=""
I SiteIEN="" D
. NEW NID,RC
. S NID=##CLASS(BEDD.EDSYSTEM).%New()
. S NID.Site=999999
. S NID.WhiteboardShowName=1
. S NID.WhiteboardShowAge=1
. S NID.WhiteboardShowProvider=1
. S NID.WhiteboardShowNurse=1
. S NID.WhiteboardShowOrders=1
. S NID.WhiteboardShowNotes=1
. S RC=NID.%Save()
. S SiteIEN=$O(^BEDD.EDSYSTEMI("SiteIdx"," 999999",""))
I SiteIEN="" Q 0
;
;Save the verify code
S EDSYS=##CLASS(BEDD.EDSYSTEM).%OpenId(SiteIEN)
S EDSYS.Verify=WVERIFY
S STS=EDSYS.%Save()
;
Q 1
;
SUPREF(SITE,PDUZ,HIDEDOB,HIDECOMP,HIDESEX,NAMEFRMT) ;EP - Save user preferences for a site/user
;
NEW UserPref,UPIEN,STS,USER
;
I $G(SITE)="" Q 0 ;No site
I $G(PDUZ)="" Q 0 ;No DUZ
;
;Look for existing entry
S UPIEN=$O(^BEDD.EDUserPreferencesI("DUZSiteIdx"," "_PDUZ," "_SITE,""))
;
;Get the patient name
S USER=$P($G(^VA(200,PDUZ,0)),"^")
;
;Edits
I UPIEN]"" D Q 1
. S UserPref=##class(BEDD.EDUserPreferences).%OpenId(UPIEN)
. S UserPref.DUZ=PDUZ
. S UserPref.HideDOB=HIDEDOB
. S UserPref.HideComp=HIDECOMP
. S UserPref.HideSex=HIDESEX
. S UserPref.Site=SITE
. S UserPref.PatientNameFormat=NAMEFRMT
. S UserPref.UserName=USER
. S STS=UserPref.%Save()
. S UserPref=""
;
;Adds
S UserPref=##class(BEDD.EDUserPreferences).%New()
S UserPref.DUZ=PDUZ
S UserPref.HideDOB=HIDEDOB
S UserPref.HideComp=HIDECOMP
S UserPref.HideSex=HIDESEX
S UserPref.Site=SITE
S UserPref.PatientNameFormat=NAMEFRMT
S UserPref.UserName=USER
S STS=UserPref.%Save()
S UserPref=""
;
Q 1
;
NMFRMT(PNAME,FRMT) ;Format Patient's Name
;
I $G(PNAME)="" Q ""
S:$G(FRMT)="" FRMT="FLFF"
;
;First Name Last Initial
I FRMT="FNLI",PNAME["," Q $P($P(PNAME,",",2)," ")_" "_$E($P(PNAME,",",1),1)
;
;Full Last, First Initial
I FRMT="FLIF",PNAME["," Q $P(PNAME,",")_", "_$E($P(PNAME,",",2),1)
;
;Last Initial, First Initial
I FRMT="ILIF",PNAME["," Q $E($P(PNAME,",",1),1)_". "_$E($P(PNAME,",",2),1)_"."
;
;Last three, First two
I FRMT="L3F2",PNAME["," Q $E($P(PNAME,",",1),1,3)_", "_$E($P(PNAME,",",2),1,2)
;
;Full (or messed up) Name
I FRMT="FLFF",PNAME["," Q $P(PNAME,",")_", "_$P(PNAME,",",2)
;
;Last Name, No First
I FRMT="LN" Q $P(PNAME,",")
;
;Messed up name
Q PNAME
BEDDPREF ;VNGT/HS/BEE-BEDD Utility Routine - Cache Calls ; 08 Nov 2011 12:00 PM
+1 ;;2.0;IHS EMERGENCY DEPT DASHBOARD;**1**;Apr 02, 2014
+2 ;
+3 ;New for BEDD*2.0*1
+4 ;
+5 ;This routine is included in the BEDD XML 2.0 Patch 1 install and is not in the KIDS
+6 ;
+7 QUIT
+8 ;
WACCESS(DUZ) ;EP - Return whether user can edit the Whiteboard settings
+1 ;
+2 IF +$GET(DUZ)=0
QUIT 0
+3 IF $$HASKEY^CIAVCXUS("BEDDZWHITEBOARD",DUZ)
QUIT 1
+4 QUIT 0
+5 ;
LUPREF(SITE,PDUZ) ;EP - Return user preferences for a site/user
+1 ;
+2 NEW UPIEN,UPREF,RESULT
+3 ;
+4 ;No site
IF $GET(SITE)=""
QUIT "0^0^0^^^"
+5 ;No DUZ
IF $GET(PDUZ)=""
QUIT "0^0^0^^^"
+6 ;
+7 ;Look for existing entry
+8 SET UPIEN=$ORDER(^BEDD.EDUserPreferencesI("DUZSiteIdx"," "_PDUZ," "_SITE,""))
+9 ;
+10 ;Entry exists
+11 SET RESULT="0^0^0^^^"
IF UPIEN]""
Begin DoDot:1
+12 SET UPREF=##class(BEDD.EDUserPreferences).%OpenId(UPIEN)
+13 SET $PIECE(RESULT,"^")=$SELECT(UPREF.HideDOB]"":UPREF.HideDOB,1:0)
+14 SET $PIECE(RESULT,"^",2)=$SELECT(UPREF.HideComp]"":UPREF.HideComp,1:0)
+15 SET $PIECE(RESULT,"^",3)=$SELECT(UPREF.HideSex]"":UPREF.HideSex,1:0)
+16 SET $PIECE(RESULT,"^",4)=$SELECT(UPREF.PatientNameFormat]"":UPREF.PatientNameFormat,1:"FLFF")
+17 SET $PIECE(RESULT,"^",5)=UPREF.UserName
+18 SET $PIECE(RESULT,"^",6)=PDUZ
End DoDot:1
+19 SET UPREF=""
+20 ;
+21 QUIT RESULT
+22 ;
CHECKWB(ACVC) ;Check Whiteboard login credentials
+1 ;
+2 NEW AC,VC,SUCCESS,SiteIEN,SITE
+3 ;
+4 SET AC=$PIECE(ACVC,";")
+5 SET VC=$PIECE(ACVC,";",2)
+6 ;
+7 ;Check Access
+8 IF AC'="Whiteboard"
QUIT 0
+9 ;
+10 ;Locate verify on file
+11 SET SiteIEN=$ORDER(^BEDD.EDSYSTEMI("SiteIdx"," 999999",""))
+12 IF SiteIEN]""
IF '$DATA(^BEDD.EDSYSTEMD(SiteIEN))
Begin DoDot:1
+13 KILL ^BEDD.EDSYSTEMI("SiteIdx"," 999999")
+14 SET SiteIEN=""
End DoDot:1
+15 IF SiteIEN=""
QUIT 0
+16 SET SITE=##CLASS(BEDD.EDSYSTEM).%OpenId(SiteIEN)
+17 IF VC'=SITE.Verify
QUIT 0
+18 ;
+19 QUIT 1
+20 ;
WBPREF(WVERIFY) ;EP - Save Whiteboard Information
+1 ;
+2 ;I $G(WVERIFY)="" Q 0
+3 ;
+4 NEW SiteIEN,EDSYS,STS
+5 ;
+6 ;Look for Whiteboard Entry
+7 SET SiteIEN=$ORDER(^BEDD.EDSYSTEMI("SiteIdx"," 999999",""))
+8 IF SiteIEN]""
IF '$DATA(^BEDD.EDSYSTEMD(SiteIEN))
Begin DoDot:1
+9 KILL ^BEDD.EDSYSTEMI("SiteIdx"," 999999")
+10 SET SiteIEN=""
End DoDot:1
+11 IF SiteIEN=""
Begin DoDot:1
+12 NEW NID,RC
+13 SET NID=##CLASS(BEDD.EDSYSTEM).%New()
+14 SET NID.Site=999999
+15 SET NID.WhiteboardShowName=1
+16 SET NID.WhiteboardShowAge=1
+17 SET NID.WhiteboardShowProvider=1
+18 SET NID.WhiteboardShowNurse=1
+19 SET NID.WhiteboardShowOrders=1
+20 SET NID.WhiteboardShowNotes=1
+21 SET RC=NID.%Save()
+22 SET SiteIEN=$ORDER(^BEDD.EDSYSTEMI("SiteIdx"," 999999",""))
End DoDot:1
+23 IF SiteIEN=""
QUIT 0
+24 ;
+25 ;Save the verify code
+26 SET EDSYS=##CLASS(BEDD.EDSYSTEM).%OpenId(SiteIEN)
+27 SET EDSYS.Verify=WVERIFY
+28 SET STS=EDSYS.%Save()
+29 ;
+30 QUIT 1
+31 ;
SUPREF(SITE,PDUZ,HIDEDOB,HIDECOMP,HIDESEX,NAMEFRMT) ;EP - Save user preferences for a site/user
+1 ;
+2 NEW UserPref,UPIEN,STS,USER
+3 ;
+4 ;No site
IF $GET(SITE)=""
QUIT 0
+5 ;No DUZ
IF $GET(PDUZ)=""
QUIT 0
+6 ;
+7 ;Look for existing entry
+8 SET UPIEN=$ORDER(^BEDD.EDUserPreferencesI("DUZSiteIdx"," "_PDUZ," "_SITE,""))
+9 ;
+10 ;Get the patient name
+11 SET USER=$PIECE($GET(^VA(200,PDUZ,0)),"^")
+12 ;
+13 ;Edits
+14 IF UPIEN]""
Begin DoDot:1
+15 SET UserPref=##class(BEDD.EDUserPreferences).%OpenId(UPIEN)
+16 SET UserPref.DUZ=PDUZ
+17 SET UserPref.HideDOB=HIDEDOB
+18 SET UserPref.HideComp=HIDECOMP
+19 SET UserPref.HideSex=HIDESEX
+20 SET UserPref.Site=SITE
+21 SET UserPref.PatientNameFormat=NAMEFRMT
+22 SET UserPref.UserName=USER
+23 SET STS=UserPref.%Save()
+24 SET UserPref=""
End DoDot:1
QUIT 1
+25 ;
+26 ;Adds
+27 SET UserPref=##class(BEDD.EDUserPreferences).%New()
+28 SET UserPref.DUZ=PDUZ
+29 SET UserPref.HideDOB=HIDEDOB
+30 SET UserPref.HideComp=HIDECOMP
+31 SET UserPref.HideSex=HIDESEX
+32 SET UserPref.Site=SITE
+33 SET UserPref.PatientNameFormat=NAMEFRMT
+34 SET UserPref.UserName=USER
+35 SET STS=UserPref.%Save()
+36 SET UserPref=""
+37 ;
+38 QUIT 1
+39 ;
NMFRMT(PNAME,FRMT) ;Format Patient's Name
+1 ;
+2 IF $GET(PNAME)=""
QUIT ""
+3 IF $GET(FRMT)=""
SET FRMT="FLFF"
+4 ;
+5 ;First Name Last Initial
+6 IF FRMT="FNLI"
IF PNAME[","
QUIT $PIECE($PIECE(PNAME,",",2)," ")_" "_$EXTRACT($PIECE(PNAME,",",1),1)
+7 ;
+8 ;Full Last, First Initial
+9 IF FRMT="FLIF"
IF PNAME[","
QUIT $PIECE(PNAME,",")_", "_$EXTRACT($PIECE(PNAME,",",2),1)
+10 ;
+11 ;Last Initial, First Initial
+12 IF FRMT="ILIF"
IF PNAME[","
QUIT $EXTRACT($PIECE(PNAME,",",1),1)_". "_$EXTRACT($PIECE(PNAME,",",2),1)_"."
+13 ;
+14 ;Last three, First two
+15 IF FRMT="L3F2"
IF PNAME[","
QUIT $EXTRACT($PIECE(PNAME,",",1),1,3)_", "_$EXTRACT($PIECE(PNAME,",",2),1,2)
+16 ;
+17 ;Full (or messed up) Name
+18 IF FRMT="FLFF"
IF PNAME[","
QUIT $PIECE(PNAME,",")_", "_$PIECE(PNAME,",",2)
+19 ;
+20 ;Last Name, No First
+21 IF FRMT="LN"
QUIT $PIECE(PNAME,",")
+22 ;
+23 ;Messed up name
+24 QUIT PNAME
