PXRMXTE.m

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

 ;

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      ;