PXRMXTE ; SLC/PJH - Reminder Reports Template Edit ;07/30/2009
;;2.0;CLINICAL REMINDERS;**4,6,12**;Feb 04, 2005;Build 73
;
; Called from PXRMYD,PXRMXD
;
;Option to Edit
;--------------
EDIT ;
N DIDEL,DIE,DR K DTOUT,DUOUT
;Edit report name, title and PXRMSEL (patient sample)
S DIE=810.1,DA=$P(PXRMTMP,U),DR=".01T;1.9;1.2",DIDEL=810.1
D ^DIE I $D(Y) S DUOUT=1 Q
;Check if template has been deleted
I '$D(DA) Q
;Get updated value of PXRMXSEL
N PXRMSEL,PXRMFUT S PXRMSEL=X
;Needed for 1.6 validation - Prior/Future or Current/Admissions
;N PXRMINP
;Further fields depend on value in PXRMXSEL
I PXRMSEL="I" S DR="6T~R",PXRMINP=0
I PXRMSEL="R" S DR="14T",PXRMINP=0
I PXRMSEL="L" D Q:$D(DUOUT)
.;Get location report type
.S DR="3T;1.5R" D ^DIE I $D(Y) S DUOUT=1 Q
.N PXRMLCSC S PXRMLCSC=X,DR="",PXRMINP=0
.;All location reports - prompt for prior/future/current/admissions
.I PXRMLCSC="HAI" S PXRMINP=1,DR="1.6" Q
.I PXRMLCSC="HA" S PXRMINP=0,DR="1.6"
.I PXRMLCSC="CA" S PXRMINP=0,DR="1.6"
.D ^DIE I $D(Y) S DUOUT=1 Q
.S PXRMFUT=X,DR=""
.;Selected Location/Stop Code/Clinic Group fields
.I PXRMLCSC="HS" D Q:$D(DUOUT)
..S DR="10T~R"
..D ^DIE I $D(Y) S DUOUT=1 Q
..;Determine if locations input are all wards
..S PXRMINP=$$INP^PXRMXAP(PXRMLCSC,.PXRMLOCN)
..;Select Prior/Future or Current Inpatient/Admissions
..S DR="1.6"
..D ^DIE I $D(Y) S DUOUT=1 Q
..S PXRMFUT=X,DR=""
.;Clinic Stop input and prior/future
.I PXRMLCSC="CS" S PXRMINP=0,DR="11T~R;1.6" D I $G(DUOUT)=1 Q
..D ^DIE I $D(Y) S DUOUT=1 Q
..S PXRMFUT=X,DR=""
.;Clinic Group input and prior/future
.I PXRMLCSC="GS" S PXRMINP=0,DR="12T~R;1.6" D I $G(DUOUT)=1 Q
..D ^DIE I $D(Y) S DUOUT=1 Q
..S PXRMFUT=X,DR=""
.;Service categories (except for inpatient reports)
.I PXRMINP=0,PXRMFUT'="F",PXRMFUT'="C" S DR=DR_";9T~R"
;OE/RR teams
I PXRMSEL="O" S DR="7T~R"
;PCMM Provider and Primary care/All
I PXRMSEL="P" S DR="4T~R;1.3"
;PCMM teams
I PXRMSEL="T" S DR="3T~R;8T~R"
D ^DIE
;Report type (detail or summary)
S DR=DR=DR_";1.4"
;Print Locations without patients and print percentages
S DR=DR_";1.7;1.8"
;Reminder Categories
I $D(^PXRMPT(810.1,DA,12,0))>0 D
.N IEN,CNT,NODE
.S CNT=0,IEN=0 F S IEN=$O(^PXRMPT(810.1,DA,12,IEN)) Q:IEN'>0 D
..S CNT=CNT+1,NODE=$G(^PXRMPT(810.1,DA,12,IEN,0))
..S PXRMTCAT(DA,CNT)=$P(NODE,U)_U_$P($G(^PXRMD(811.7,$P(NODE,U),0)),U)_U_$P(NODE,U,2)
S DR=DR_";13T"
;Reminders
I $D(^PXRMPT(810.1,DA,1,0))>0 D
.N IEN,CNT,NODE,REMNODE
.S CNT=0,IEN=0 F S IEN=$O(^PXRMPT(810.1,DA,1,IEN)) Q:IEN'>0 D
..S CNT=CNT+1,NODE=$G(^PXRMPT(810.1,DA,1,IEN,0))
..S REMNODE=$G(^PXD(811.9,$P(NODE,U),0))
..S PXRMTREM(DA,CNT)=$P(NODE,U)_U_$P(REMNODE,U)_U_$P(NODE,U,2)_U_$P($G(REMNODE),U,3)
S DR=DR_";2T"
;
;Strip of any leading semi-colons
I $E(DR)=";" S DR=$P(DR,";",2,99)
;
D ^DIE I $D(Y) S DUOUT=1 Q
;
;if manager all an owner to be assigned
I $D(^XUSEC("PXRM MANAGER",DUZ)) S DR="15" D ^DIE
;
;If all reminders have been deleted from the template disallow save
I +$P($G(^PXRMPT(810.1,DA,1,0)),U,4)=0 D
.;Check categories also
.I +$P($G(^PXRMPT(810.1,DA,12,0)),U,4)>0 D Q
.. N CAT,CATIEN
.. S CAT=0 F S CAT=$O(^PXRMPT(810.1,DA,12,CAT)) Q:+CAT'>0 D
... S CATIEN=$P($G(^PXRMPT(810.1,DA,12,CAT,0)),U)
... I +$P($G(^PXRMD(811.7,CATIEN,2,0)),U,4)<1 W !!,"** WARNING **",!,"Reminder Category "_$P($G(^PXRMD(811.7,CATIEN,0)),U)_" does not have any reminders assigned to it"
.S DUOUT=1
.W !!,"No reminders defined"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMXTE 3570 printed Oct 16, 2024@17:51:18 Page 2
PXRMXTE ; SLC/PJH - Reminder Reports Template Edit ;07/30/2009
+1 ;;2.0;CLINICAL REMINDERS;**4,6,12**;Feb 04, 2005;Build 73
+2 ;
+3 ; Called from PXRMYD,PXRMXD
+4 ;
+5 ;Option to Edit
+6 ;--------------
EDIT ;
+1 NEW DIDEL,DIE,DR
KILL DTOUT,DUOUT
+2 ;Edit report name, title and PXRMSEL (patient sample)
+3 SET DIE=810.1
SET DA=$PIECE(PXRMTMP,U)
SET DR=".01T;1.9;1.2"
SET DIDEL=810.1
+4 DO ^DIE
IF $DATA(Y)
SET DUOUT=1
QUIT
+5 ;Check if template has been deleted
+6 IF '$DATA(DA)
QUIT
+7 ;Get updated value of PXRMXSEL
+8 NEW PXRMSEL,PXRMFUT
SET PXRMSEL=X
+9 ;Needed for 1.6 validation - Prior/Future or Current/Admissions
+10 ;N PXRMINP
+11 ;Further fields depend on value in PXRMXSEL
+12 IF PXRMSEL="I"
SET DR="6T~R"
SET PXRMINP=0
+13 IF PXRMSEL="R"
SET DR="14T"
SET PXRMINP=0
+14 IF PXRMSEL="L"
Begin DoDot:1
+15 ;Get location report type
+16 SET DR="3T;1.5R"
DO ^DIE
IF $DATA(Y)
SET DUOUT=1
QUIT
+17 NEW PXRMLCSC
SET PXRMLCSC=X
SET DR=""
SET PXRMINP=0
+18 ;All location reports - prompt for prior/future/current/admissions
+19 IF PXRMLCSC="HAI"
SET PXRMINP=1
SET DR="1.6"
QUIT
+20 IF PXRMLCSC="HA"
SET PXRMINP=0
SET DR="1.6"
+21 IF PXRMLCSC="CA"
SET PXRMINP=0
SET DR="1.6"
+22 DO ^DIE
IF $DATA(Y)
SET DUOUT=1
QUIT
+23 SET PXRMFUT=X
SET DR=""
+24 ;Selected Location/Stop Code/Clinic Group fields
+25 IF PXRMLCSC="HS"
Begin DoDot:2
+26 SET DR="10T~R"
+27 DO ^DIE
IF $DATA(Y)
SET DUOUT=1
QUIT
+28 ;Determine if locations input are all wards
+29 SET PXRMINP=$$INP^PXRMXAP(PXRMLCSC,.PXRMLOCN)
+30 ;Select Prior/Future or Current Inpatient/Admissions
+31 SET DR="1.6"
+32 DO ^DIE
IF $DATA(Y)
SET DUOUT=1
QUIT
+33 SET PXRMFUT=X
SET DR=""
End DoDot:2
if $DATA(DUOUT)
QUIT
+34 ;Clinic Stop input and prior/future
+35 IF PXRMLCSC="CS"
SET PXRMINP=0
SET DR="11T~R;1.6"
Begin DoDot:2
+36 DO ^DIE
IF $DATA(Y)
SET DUOUT=1
QUIT
+37 SET PXRMFUT=X
SET DR=""
End DoDot:2
IF $GET(DUOUT)=1
QUIT
+38 ;Clinic Group input and prior/future
+39 IF PXRMLCSC="GS"
SET PXRMINP=0
SET DR="12T~R;1.6"
Begin DoDot:2
+40 DO ^DIE
IF $DATA(Y)
SET DUOUT=1
QUIT
+41 SET PXRMFUT=X
SET DR=""
End DoDot:2
IF $GET(DUOUT)=1
QUIT
+42 ;Service categories (except for inpatient reports)
+43 IF PXRMINP=0
IF PXRMFUT'="F"
IF PXRMFUT'="C"
SET DR=DR_";9T~R"
End DoDot:1
if $DATA(DUOUT)
QUIT
+44 ;OE/RR teams
+45 IF PXRMSEL="O"
SET DR="7T~R"
+46 ;PCMM Provider and Primary care/All
+47 IF PXRMSEL="P"
SET DR="4T~R;1.3"
+48 ;PCMM teams
+49 IF PXRMSEL="T"
SET DR="3T~R;8T~R"
+50 DO ^DIE
+51 ;Report type (detail or summary)
+52 SET DR=DR=DR_";1.4"
+53 ;Print Locations without patients and print percentages
+54 SET DR=DR_";1.7;1.8"
+55 ;Reminder Categories
+56 IF $DATA(^PXRMPT(810.1,DA,12,0))>0
Begin DoDot:1
+57 NEW IEN,CNT,NODE
+58 SET CNT=0
SET IEN=0
FOR
SET IEN=$ORDER(^PXRMPT(810.1,DA,12,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+59 SET CNT=CNT+1
SET NODE=$GET(^PXRMPT(810.1,DA,12,IEN,0))
+60 SET PXRMTCAT(DA,CNT)=$PIECE(NODE,U)_U_$PIECE($GET(^PXRMD(811.7,$PIECE(NODE,U),0)),U)_U_$PIECE(NODE,U,2)
End DoDot:2
End DoDot:1
+61 SET DR=DR_";13T"
+62 ;Reminders
+63 IF $DATA(^PXRMPT(810.1,DA,1,0))>0
Begin DoDot:1
+64 NEW IEN,CNT,NODE,REMNODE
+65 SET CNT=0
SET IEN=0
FOR
SET IEN=$ORDER(^PXRMPT(810.1,DA,1,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+66 SET CNT=CNT+1
SET NODE=$GET(^PXRMPT(810.1,DA,1,IEN,0))
+67 SET REMNODE=$GET(^PXD(811.9,$PIECE(NODE,U),0))
+68 SET PXRMTREM(DA,CNT)=$PIECE(NODE,U)_U_$PIECE(REMNODE,U)_U_$PIECE(NODE,U,2)_U_$PIECE($GET(REMNODE),U,3)
End DoDot:2
End DoDot:1
+69 SET DR=DR_";2T"
+70 ;
+71 ;Strip of any leading semi-colons
+72 IF $EXTRACT(DR)=";"
SET DR=$PIECE(DR,";",2,99)
+73 ;
+74 DO ^DIE
IF $DATA(Y)
SET DUOUT=1
QUIT
+75 ;
+76 ;if manager all an owner to be assigned
+77 IF $DATA(^XUSEC("PXRM MANAGER",DUZ))
SET DR="15"
DO ^DIE
+78 ;
+79 ;If all reminders have been deleted from the template disallow save
+80 IF +$PIECE($GET(^PXRMPT(810.1,DA,1,0)),U,4)=0
Begin DoDot:1
+81 ;Check categories also
+82 IF +$PIECE($GET(^PXRMPT(810.1,DA,12,0)),U,4)>0
Begin DoDot:2
+83 NEW CAT,CATIEN
+84 SET CAT=0
FOR
SET CAT=$ORDER(^PXRMPT(810.1,DA,12,CAT))
if +CAT'>0
QUIT
Begin DoDot:3
+85 SET CATIEN=$PIECE($GET(^PXRMPT(810.1,DA,12,CAT,0)),U)
+86 IF +$PIECE($GET(^PXRMD(811.7,CATIEN,2,0)),U,4)<1
WRITE !!,"** WARNING **",!,"Reminder Category "_$PIECE($GET(^PXRMD(811.7,CATIEN,0)),U)_" does not have any reminders assigned to it"
End DoDot:3
End DoDot:2
QUIT
+87 SET DUOUT=1
+88 WRITE !!,"No reminders defined"
End DoDot:1
+89 QUIT
+90 ;
