PXRMEHR ;SLC/AGP - Computed findings for EHR cutover. ;Apr 25, 2023@13:17
;;2.0;CLINICAL REMINDERS;**82**;Feb 4, 2005;Build 28
;
; Reference to ACCESS^ORACCESS in ICR #7356
; Reference to TABNAMES^ORACCESS in ICR #7356
;
CUTOVER(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;
N ACCESS,ALLORDERS,CNT,CUTOVER,DG,DGACCESS,NOTES,OTHACCESS,PXRMWA,SRT,TAB,TABS,TCNT,TXT
S NFOUND=0,TCNT=0
;I '$$ONEHR^ORACCESS Q
;format write access into local array
D ACCESS^ORACCESS(.PXRMWA,DUZ,2,.NOTES)
F TAB="consults","dcSumm","meds","notes","orders","problems","surgery" D
.I $G(PXRMWA("cprsAccess",TAB,"writeAccess"))'=1 Q
.S ACCESS(TAB)=""
F TAB="allergy","delayedOrders","encounters","immunization","reminderEditor","vital","womenHealth" D
.I $G(PXRMWA("cprsAccess",TAB,"writeAccess"))'=1 Q
.S OTHACCESS(TAB)=""
I $D(ACCESS("orders")) D
.S ALLORDERS=1
.S CNT=0 F S CNT=$O(PXRMWA("cprsAccess","orders","displayGroups",CNT)) Q:CNT'>0 D
..I $G(PXRMWA("cprsAccess","orders","displayGroups",CNT,"writeAccess"))'=1 S ALLORDERS=0 Q
..S DG=$G(PXRMWA("cprsAccess","orders","displayGroups",CNT,"name")) I DG="" Q
..S DGACCESS(DG)=""
;
I '$D(ACCESS),'$D(OTHACCESS) D Q
.S NFOUND=1
.S TEST(1)=1
.S DATE(1)=DT
.S DATA(1,"NO ACCESS")="No CPRS write access allowed"
.I $D(NOTES) D
..S DATA(NFOUND,"ADDITIONAL INFO")="",TXT="\\"
..S CNT=0 F S CNT=$O(NOTES(CNT)) Q:'CNT D
...S TCNT=TCNT+1,TEXT(TCNT)="\\"_NOTES(CNT)
...I NOTES(CNT)="" S TXT="\\ \\"
...E D
....S DATA(NFOUND,"ADDITIONAL INFO")=DATA(NFOUND,"ADDITIONAL INFO")_TXT_NOTES(CNT)
....S TXT="\\"
D TABNAMES^ORACCESS(.TABS)
S NFOUND=1,TEST(1)=1
S DATE(1)=DT
S TCNT=0
;evaluate CPRS Tab write functionality
S DATA(NFOUND,"TAB ACCESS")="No write access to Consults, Discharge Summaries, Meds, Notes, Orders, Problems, Surgery"
I $D(ACCESS) D
.S DATA(NFOUND,"TAB ACCESS")="Write access allow for the following tabs:"
.S TCNT=TCNT+1,TEXT(TCNT)=DATA(NFOUND,"TAB ACCESS")
.S TAB="",CNT=0 F S TAB=$O(ACCESS(TAB)) Q:TAB="" D
..S CNT=CNT+1,DATA(NFOUND,"TABS",CNT)=$G(TABS(TAB))_$$TEMPLATE(.PXRMWA,TAB)
..S TCNT=TCNT+1,TEXT(TCNT)="\\ "_DATA(NFOUND,"TABS",CNT)
;
;evaluate other information write access
S DATA(NFOUND,"OTHER ACCESS")="No write access for Allergies, Encounters, Immunizations, Reminder Coversheet Editor, Vitals, Women Health"
I $D(OTHACCESS) D
.S DATA(NFOUND,"OTHER ACCESS")="Write access allow for the following additional functionality:"
.I TCNT>0 S TCNT=TCNT+1,TEXT(TCNT)="\\ \\Write access allow for the following functionality"
.S TAB="",CNT=0 F S TAB=$O(OTHACCESS(TAB)) Q:TAB="" D
..I TAB="delayedOrders" Q
..S CNT=CNT+1,DATA(NFOUND,"OTHER",CNT)=$G(TABS(TAB))
..S TCNT=TCNT+1,TEXT(TCNT)="\\ \\"_DATA(NFOUND,"OTHER",CNT)
;
I $D(NOTES) D
.S DATA(NFOUND,"ADDITIONAL INFO")="",TXT="\\"
.S CNT=0 F S CNT=$O(NOTES(CNT)) Q:'CNT D
..S TCNT=TCNT+1,TEXT(TCNT)="\\"_NOTES(CNT)
..I NOTES(CNT)="" S TXT="\\ \\"
..E D
...S DATA(NFOUND,"ADDITIONAL INFO")=DATA(NFOUND,"ADDITIONAL INFO")_TXT_NOTES(CNT)
...S TXT="\\"
;
;evaluate ordering write access
I '$D(ACCESS("orders")) Q
I $G(ALLORDERS)=1,$D(OTHACCESS("delayedOrders")) D Q
.S TCNT=TCNT+1,TEXT(TCNT)="All order functionality is enabled"
.;S DATA(NFOUND,"ORDER TEXT")="All order functionality is enabled"
S TCNT=TCNT+1,TEXT(TCNT)="\\Ordering write access allow for the following display groups:"
S DATA(NFOUND,"ORDER ACCESS")="Ordering write access is allow for the following display groups"
S DG="",CNT=0 F S DG=$O(DGACCESS(DG)) Q:DG="" D
.S CNT=CNT+1,DATA(NFOUND,"DISPLAY GROUPS",CNT)=DG
.S TCNT=TCNT+1,TEXT(TCNT)="\\ "_DG
;
S DATA(NFOUND,"DELAYED ORDER")=$S('$D(OTHACCESS("delayedOrders")):"Delayed Order not allowed",1:"Delayed Orders allowed")
S TCNT=TCNT+1,TEXT(TCNT)="\\ \\Delayed Orders "_$S('$D(OTHACCESS("delayedOrders")):"is not allowed",1:"is allowed")
;
Q
;
TEMPLATE(PXRMWA,TAB) ;
I TAB'="consults",TAB'="dcSumm",TAB'="notes",TAB'="surgery" Q ""
I PXRMWA("cprsAccess",TAB,"writeAccess")=1 Q ", template access allowed"
Q ", template access not allowed"
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMEHR 4148 printed Dec 13, 2024@01:44:31 Page 2
PXRMEHR ;SLC/AGP - Computed findings for EHR cutover. ;Apr 25, 2023@13:17
+1 ;;2.0;CLINICAL REMINDERS;**82**;Feb 4, 2005;Build 28
+2 ;
+3 ; Reference to ACCESS^ORACCESS in ICR #7356
+4 ; Reference to TABNAMES^ORACCESS in ICR #7356
+5 ;
CUTOVER(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;
+1 NEW ACCESS,ALLORDERS,CNT,CUTOVER,DG,DGACCESS,NOTES,OTHACCESS,PXRMWA,SRT,TAB,TABS,TCNT,TXT
+2 SET NFOUND=0
SET TCNT=0
+3 ;I '$$ONEHR^ORACCESS Q
+4 ;format write access into local array
+5 DO ACCESS^ORACCESS(.PXRMWA,DUZ,2,.NOTES)
+6 FOR TAB="consults","dcSumm","meds","notes","orders","problems","surgery"
Begin DoDot:1
+7 IF $GET(PXRMWA("cprsAccess",TAB,"writeAccess"))'=1
QUIT
+8 SET ACCESS(TAB)=""
End DoDot:1
+9 FOR TAB="allergy","delayedOrders","encounters","immunization","reminderEditor","vital","womenHealth"
Begin DoDot:1
+10 IF $GET(PXRMWA("cprsAccess",TAB,"writeAccess"))'=1
QUIT
+11 SET OTHACCESS(TAB)=""
End DoDot:1
+12 IF $DATA(ACCESS("orders"))
Begin DoDot:1
+13 SET ALLORDERS=1
+14 SET CNT=0
FOR
SET CNT=$ORDER(PXRMWA("cprsAccess","orders","displayGroups",CNT))
if CNT'>0
QUIT
Begin DoDot:2
+15 IF $GET(PXRMWA("cprsAccess","orders","displayGroups",CNT,"writeAccess"))'=1
SET ALLORDERS=0
QUIT
+16 SET DG=$GET(PXRMWA("cprsAccess","orders","displayGroups",CNT,"name"))
IF DG=""
QUIT
+17 SET DGACCESS(DG)=""
End DoDot:2
End DoDot:1
+18 ;
+19 IF '$DATA(ACCESS)
IF '$DATA(OTHACCESS)
Begin DoDot:1
+20 SET NFOUND=1
+21 SET TEST(1)=1
+22 SET DATE(1)=DT
+23 SET DATA(1,"NO ACCESS")="No CPRS write access allowed"
+24 IF $DATA(NOTES)
Begin DoDot:2
+25 SET DATA(NFOUND,"ADDITIONAL INFO")=""
SET TXT="\\"
+26 SET CNT=0
FOR
SET CNT=$ORDER(NOTES(CNT))
if 'CNT
QUIT
Begin DoDot:3
+27 SET TCNT=TCNT+1
SET TEXT(TCNT)="\\"_NOTES(CNT)
+28 IF NOTES(CNT)=""
SET TXT="\\ \\"
+29 IF '$TEST
Begin DoDot:4
+30 SET DATA(NFOUND,"ADDITIONAL INFO")=DATA(NFOUND,"ADDITIONAL INFO")_TXT_NOTES(CNT)
+31 SET TXT="\\"
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+32 DO TABNAMES^ORACCESS(.TABS)
+33 SET NFOUND=1
SET TEST(1)=1
+34 SET DATE(1)=DT
+35 SET TCNT=0
+36 ;evaluate CPRS Tab write functionality
+37 SET DATA(NFOUND,"TAB ACCESS")="No write access to Consults, Discharge Summaries, Meds, Notes, Orders, Problems, Surgery"
+38 IF $DATA(ACCESS)
Begin DoDot:1
+39 SET DATA(NFOUND,"TAB ACCESS")="Write access allow for the following tabs:"
+40 SET TCNT=TCNT+1
SET TEXT(TCNT)=DATA(NFOUND,"TAB ACCESS")
+41 SET TAB=""
SET CNT=0
FOR
SET TAB=$ORDER(ACCESS(TAB))
if TAB=""
QUIT
Begin DoDot:2
+42 SET CNT=CNT+1
SET DATA(NFOUND,"TABS",CNT)=$GET(TABS(TAB))_$$TEMPLATE(.PXRMWA,TAB)
+43 SET TCNT=TCNT+1
SET TEXT(TCNT)="\\ "_DATA(NFOUND,"TABS",CNT)
End DoDot:2
End DoDot:1
+44 ;
+45 ;evaluate other information write access
+46 SET DATA(NFOUND,"OTHER ACCESS")="No write access for Allergies, Encounters, Immunizations, Reminder Coversheet Editor, Vitals, Women Health"
+47 IF $DATA(OTHACCESS)
Begin DoDot:1
+48 SET DATA(NFOUND,"OTHER ACCESS")="Write access allow for the following additional functionality:"
+49 IF TCNT>0
SET TCNT=TCNT+1
SET TEXT(TCNT)="\\ \\Write access allow for the following functionality"
+50 SET TAB=""
SET CNT=0
FOR
SET TAB=$ORDER(OTHACCESS(TAB))
if TAB=""
QUIT
Begin DoDot:2
+51 IF TAB="delayedOrders"
QUIT
+52 SET CNT=CNT+1
SET DATA(NFOUND,"OTHER",CNT)=$GET(TABS(TAB))
+53 SET TCNT=TCNT+1
SET TEXT(TCNT)="\\ \\"_DATA(NFOUND,"OTHER",CNT)
End DoDot:2
End DoDot:1
+54 ;
+55 IF $DATA(NOTES)
Begin DoDot:1
+56 SET DATA(NFOUND,"ADDITIONAL INFO")=""
SET TXT="\\"
+57 SET CNT=0
FOR
SET CNT=$ORDER(NOTES(CNT))
if 'CNT
QUIT
Begin DoDot:2
+58 SET TCNT=TCNT+1
SET TEXT(TCNT)="\\"_NOTES(CNT)
+59 IF NOTES(CNT)=""
SET TXT="\\ \\"
+60 IF '$TEST
Begin DoDot:3
+61 SET DATA(NFOUND,"ADDITIONAL INFO")=DATA(NFOUND,"ADDITIONAL INFO")_TXT_NOTES(CNT)
+62 SET TXT="\\"
End DoDot:3
End DoDot:2
End DoDot:1
+63 ;
+64 ;evaluate ordering write access
+65 IF '$DATA(ACCESS("orders"))
QUIT
+66 IF $GET(ALLORDERS)=1
IF $DATA(OTHACCESS("delayedOrders"))
Begin DoDot:1
+67 SET TCNT=TCNT+1
SET TEXT(TCNT)="All order functionality is enabled"
+68 ;S DATA(NFOUND,"ORDER TEXT")="All order functionality is enabled"
End DoDot:1
QUIT
+69 SET TCNT=TCNT+1
SET TEXT(TCNT)="\\Ordering write access allow for the following display groups:"
+70 SET DATA(NFOUND,"ORDER ACCESS")="Ordering write access is allow for the following display groups"
+71 SET DG=""
SET CNT=0
FOR
SET DG=$ORDER(DGACCESS(DG))
if DG=""
QUIT
Begin DoDot:1
+72 SET CNT=CNT+1
SET DATA(NFOUND,"DISPLAY GROUPS",CNT)=DG
+73 SET TCNT=TCNT+1
SET TEXT(TCNT)="\\ "_DG
End DoDot:1
+74 ;
+75 SET DATA(NFOUND,"DELAYED ORDER")=$SELECT('$DATA(OTHACCESS("delayedOrders")):"Delayed Order not allowed",1:"Delayed Orders allowed")
+76 SET TCNT=TCNT+1
SET TEXT(TCNT)="\\ \\Delayed Orders "_$SELECT('$DATA(OTHACCESS("delayedOrders")):"is not allowed",1:"is allowed")
+77 ;
+78 QUIT
+79 ;
TEMPLATE(PXRMWA,TAB) ;
+1 IF TAB'="consults"
IF TAB'="dcSumm"
IF TAB'="notes"
IF TAB'="surgery"
QUIT ""
+2 IF PXRMWA("cprsAccess",TAB,"writeAccess")=1
QUIT ", template access allowed"
+3 QUIT ", template access not allowed"
+4 ;
