PXRMDD41.m

PXRMDD41 ; SLC/PJH Reminder Dialog file calls ;11/22/2000

 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

 ;

 ;copied from ORDD41 for dialog reminders

 ;

 ;

KILL(DLG) ;

 Q

 ;

 ; Update audit trail when ITEMS changed

REDOX I $D(^PXRMD(801.41,+$G(DA(1)),0)) S $P(^(99),U)=$$NOW^XLFDT

 Q

 ;

SCREEN ;validate dialog type

 Q:'$G(DA(1))

 N PXRMMTYP

 S PXRMMTYP=$P($G(^PXRMD(801.41,DA(1),0)),U,4)

 ;MH results and Reminder dialogs dissallowed

 S DIC("S")="I ""RST""'[$P(^(0),U,4)"

 ;Dialog elements can only contain prompts/forced values

 I PXRMMTYP="E" S DIC("S")="I ""FP""[$P(^(0),U,4)"

 ;Reminder dialogs can contain only Elements and Groups

 I PXRMMTYP="R" S DIC("S")="I ""EG""[$P(^(0),U,4)"

 ;MH Result Groups can only contain MH Result Elementss

 I PXRMMTYP="S" S DIC("S")="I ""T""=$P(^(0),U,4)"

 ;Dialog groups cannot point to themselves

 I PXRMMTYP="G" D

 .S DIC("S")=DIC("S")_"&($G(Y)'=DA(1))"

 Q

 ;

 ; UPDATE last amend date

SET(DLG) ;

 S $P(^PXRMD(801.41,DLG,99),U)=$$NOW^XLFDT

 Q

 ;

 ; -- Ck menu tree to ensure new item is not an ancestor

 ;    Input Xform for Item field #2 of Items subfile #801.412

 ;      expecting DA, DA(1), X from FileMan

TREE ;

 D SCREEN

 N PXRMDDA,PXRMDD S PXRMDDA=DA(1)

 K:X=PXRMDDA X D TREE1

 Q

 ; -- Look for X in ancestors

TREE1 F PXRMDD=0:0 Q:'$D(X)  S PXRMDD=$O(^PXRMD(801.41,"AD",PXRMDDA,PXRMDD)) Q:PXRMDD'>0  K:X=PXRMDD X Q:'$D(X)  D TREE2

 Q

 ; Back up another level

TREE2 N PXRMDDA S PXRMDDA=PXRMDD N PXRMDD D TREE1

 Q

PXRMDD41  ; SLC/PJH Reminder Dialog file calls ;11/22/2000

 +1       ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

 +2       ;

 +3       ;copied from ORDD41 for dialog reminders

 +4       ;

 +5       ;

KILL(DLG) ;

 +1        QUIT 

 +2       ;

 +3       ; Update audit trail when ITEMS changed

REDOX      IF $DATA(^PXRMD(801.41,+$GET(DA(1)),0))

               SET $PIECE(^(99),U)=$$NOW^XLFDT

 +1        QUIT 

 +2       ;

SCREEN    ;validate dialog type

 +1        IF '$GET(DA(1))

               QUIT 

 +2        NEW PXRMMTYP

 +3        SET PXRMMTYP=$PIECE($GET(^PXRMD(801.41,DA(1),0)),U,4)

 +4       ;MH results and Reminder dialogs dissallowed

 +5        SET DIC("S")="I ""RST""'[$P(^(0),U,4)"

 +6       ;Dialog elements can only contain prompts/forced values

 +7        IF PXRMMTYP="E"

               SET DIC("S")="I ""FP""[$P(^(0),U,4)"

 +8       ;Reminder dialogs can contain only Elements and Groups

 +9        IF PXRMMTYP="R"

               SET DIC("S")="I ""EG""[$P(^(0),U,4)"

 +10      ;MH Result Groups can only contain MH Result Elementss

 +11       IF PXRMMTYP="S"

               SET DIC("S")="I ""T""=$P(^(0),U,4)"

 +12      ;Dialog groups cannot point to themselves

 +13       IF PXRMMTYP="G"

               Begin DoDot:1

 +14               SET DIC("S")=DIC("S")_"&($G(Y)'=DA(1))"

               End DoDot:1

 +15       QUIT 

 +16      ;

 +17      ; UPDATE last amend date

SET(DLG)  ;

 +1        SET $PIECE(^PXRMD(801.41,DLG,99),U)=$$NOW^XLFDT

 +2        QUIT 

 +3       ;

 +4       ; -- Ck menu tree to ensure new item is not an ancestor

 +5       ;    Input Xform for Item field #2 of Items subfile #801.412

 +6       ;      expecting DA, DA(1), X from FileMan

TREE      ;

 +1        DO SCREEN

 +2        NEW PXRMDDA,PXRMDD

           SET PXRMDDA=DA(1)

 +3        IF X=PXRMDDA

               KILL X

           DO TREE1

 +4        QUIT 

 +5       ; -- Look for X in ancestors

TREE1      FOR PXRMDD=0:0

               IF '$DATA(X)

                   QUIT 

               SET PXRMDD=$ORDER(^PXRMD(801.41,"AD",PXRMDDA,PXRMDD))

               IF PXRMDD'>0

                   QUIT 

               IF X=PXRMDD

                   KILL X

               IF '$DATA(X)

                   QUIT 

               DO TREE2

 +1        QUIT 

 +2       ; Back up another level

TREE2      NEW PXRMDDA

           SET PXRMDDA=PXRMDD

           NEW PXRMDD

           DO TREE1

 +1        QUIT