PXRMDBL ;SLC/AGP - Reminder Dialog Field editor/List Manager Tester ;07/31/2020
;;2.0;CLINICAL REMINDERS;**45,42**;Feb 04, 2005;Build 245
;
ACTION(IDS,Y) ;
I $G(PXRMINST)=1 Q 1
I $G(PXRMEXCH)=1 Q 1
I +$G(IDS(1))'>0 Q 0
I +$G(IDS)'>0 Q 0
I Y="H"!(Y="HIDE") Q 1
I Y="R"!(Y="REPLACE") Q 1
I Y="S"!(Y["SUPPRESS") Q 1
I Y="C"!(Y="CHECK CHECKBOX") Q 1
I $P($G(^PXRMD(801.41,IDS(1),0)),U,4)="G"&(Y="0"!(+Y>0)!(Y["SELECTION")) Q 1
Q 0
;
BUILDTXT(CNT,MESS,NAME,EXT,PIECE,SEQ) ;
N ERR
S ERR(1)="The "_EXT_" "_NAME_" branching logic sequence #"_SEQ_" field "_$S(PIECE=1:"Sequence",PIECE=2:"Evaluation Item",PIECE=3:"Evaluation Status",PIECE=4:"Action",PIECE=5:"Replacement Item",1:"")_" is missing a value."
D BUILDMSG^PXRMDLRP(.ERR,.CNT,.MESS,1)
Q
;
CHECK1(DIEN,NAME,EXT,CNT,ERR,FAIL) ;
N I,IEN,J,NODE,SEQ,TEMP,TYPE,VALID
S VALID=""
S TYPE=$P($G(^PXRMD(801.41,DIEN,0)),U,4)
S IEN=0 F S IEN=$O(^PXRMD(801.41,DIEN,"BL",IEN)) Q:IEN'>0!(VALID="F") D
.S NODE=$G(^PXRMD(801.41,DIEN,"BL",IEN,0))
.F I=.01,1,2,3 D Q:VALID'=""
..S SEQ=$P(NODE,U)
..;at least first three field must be defined
..I I=.01 F J=1,2,3 D Q:VALID="F"
...I $P(NODE,U,J+1)="" S VALID="F" D BUILDTXT(.CNT,.ERR,NAME,EXT,J+1,SEQ)
..;if eval item, status and action must be defined
..I I=1 F J=2,3 D Q:VALID'=""
...I $P(NODE,U,J+1)="" S VALID="F" D BUILDTXT(.CNT,.ERR,NAME,EXT,J+1,SEQ)
..;if status action must be defined
..I I=2 I $P(NODE,U,4)="" S VALID="F" D BUILDTXT(.CNT,.ERR,NAME,EXT,4,SEQ) Q
..I I=3 D Q
...;if action is repl dialog must be defined
...I $P(NODE,U,4)="R",$P(NODE,U,5)'>0 S VALID="F" D BUILDTXT(.CNT,.ERR,NAME,EXT,5,SEQ) Q
...I $P(NODE,U,4)="0"!(+$P(NODE,U,4)>0) D
....I TYPE'="G" D
.....S TEMP(1)="The "_EXT_" "_NAME_" branching logic sequence #"_SEQ_" Evaluation Item is not a group."
.....D BUILDMSG^PXRMDLRP(.TEMP,.CNT,.ERR,1) S VALID="F"
.I VALID'="F" D VALIDREM(NAME,EXT,$P(NODE,U,2),.CNT,.ERR,.VALID)
I VALID="F" G CHECK1X
D CHCKEVST(DIEN,NAME,EXT,.CNT,.ERR,.VALID)
CHECK1X ;
I FAIL'="F" S FAIL=VALID
Q
;
;
CHCKEVST(DIEN,NAME,EXT,CNT,ERR,FAIL) ;
N ARRAY,DEFAULTS,EVALITEM,FOUND,IEN,IDX,ITEM,NODE,SEQ,TEMP,TYPE,NODE,STATUS
S DEFAULTS("TERM")=2,DEFAULTS("TERM","F")="",DEFAULTS("TERM","T")=""
S DEFAULTS("DEF")=3,DEFAULTS("DEF","A")="",DEFAULTS("DEF","D")="",DEFAULTS("DEF","N")=""
S IEN=0 F S IEN=$O(^PXRMD(801.41,DIEN,"BL",IEN)) Q:IEN'>0!(FAIL'="") D
.S NODE=$G(^PXRMD(801.41,DIEN,"BL",IEN,0))
.S EVALITEM=$P(NODE,U,2),SEQ=$P(NODE,U),STATUS=$P(NODE,U,3)
.S TYPE=$S(EVALITEM["811.5":"TERM",EVALITEM["811.9":"DEF",1:"UNK")
.I TYPE="TERM"&(STATUS'="T"&(STATUS'="F")) D HELP(NAME,EXT,.CNT,.ERR,1,SEQ) S FAIL="F" Q
.I TYPE="DEF"&(STATUS'="D"&(STATUS'="A")&(STATUS'="N")) D HELP(NAME,EXT,.CNT,.ERR,2,SEQ) S FAIL="F" Q
.;CHECK FOR DUPLICATES
.I $D(ARRAY(TYPE,EVALITEM,STATUS)) D HELP(NAME,EXT,.ERR,$S(EVALITEM["811.5":4,1:3),SEQ) S FAIL="F" Q
.S ARRAY(TYPE,EVALITEM,STATUS)=""
;loop through array of entries to check if every status is selected
I FAIL'="" Q
F TYPE="DEF","TERM" D
.S ITEM=0 F S ITEM=$O(ARRAY(TYPE,ITEM)) Q:ITEM'>0!(FAIL'="") D
..;reset default list
..M TEMP=DEFAULTS
..S STATUS="" F S STATUS=$O(ARRAY(TYPE,ITEM,STATUS)) Q:STATUS="" D
...I $D(TEMP(TYPE,STATUS)) K TEMP(TYPE,STATUS) S TEMP(TYPE)=TEMP(TYPE)-1
..;I $D(TEMP(TYPE,STATUS)) K TEMP(TYPE,STATUS) S TEMP(TYPE)=TEMP(TYPE)-1
..I TEMP(TYPE)<1 D HELP(NAME,EXT,.CNT,.ERR,5,SEQ) S FAIL="W"
Q
;
CHECKITM(DA,VALUE) ;
N IENS,NODE
S IENS=DA_","_DA(1)_","
S NODE=$G(^PXRMD(801.41,DA(1),"BL",DA,0))
I VALUE="",$P(NODE,U)>0 D DELFIELD(IENS,801.41143,.01) Q 0
Q 1
;
DELFIELD(IENS,SUB,FIELD) ;Delete a field.
N FDA,MSG
S FDA(SUB,IENS,FIELD)="@"
D FILE^DIE("","FDA","MSG")
I $D(MSG) W !,"Error in delete",! D AWRITE^PXRMUTIL("MSG")
Q
;
DELREPL(DA,FIELD,OLD,NEW) ;
N IENS,X
I OLD="" Q
S IENS=DA_","_DA(1)_","
;I FIELD=.01,NEW="" F X=1,2,3,4 D DELFIELD(IENS,801.41143,X)
I FIELD=1,$P(OLD,";",2)'=$P(NEW,";",2) D
.F X=2,3,4 D DELFIELD(IENS,801.41143,X)
.;I NEW="",+$P($G(^PXRMD(801.41,DA(1),"BL",DA,0)),U)>0 D DELFIELD(IENS,801.41143,.01)
I FIELD=2,NEW="" F X=3,4 D DELFIELD(IENS,801.41143,X)
I FIELD=3,$G(OLD)="R",$G(NEW)'="R" D DELFIELD(IENS,801.41143,4)
I FIELD=3,NEW="" D DELFIELD(IENS,801.41143,X)
Q
;
EVALSTAT(IDS,Y) ;
N ISTERM,NODE
I $G(PXRMINST)=1 Q 1
I $G(PXRMEXCH)=1 Q 1
I +$G(IDS(1))'>0 Q 0
I +$G(IDS)'>0 Q 0
S NODE=$G(^PXRMD(801.41,IDS(1),"BL",IDS,0)) I NODE="" Q 0
S ISTERM=$S($P(NODE,U,2)[811.5:1,1:0)
I ISTERM=1&(Y="F"!(Y="T"))!(Y="TRUE")!(Y="FALSE") Q 1
I ISTERM=0&(Y="D"!(Y="A")!(Y="N"))!(Y="DUE")!(Y="APPLICABLE")!(Y="N/A") Q 1
Q 0
;
HELP(NAME,EXT,CNT,MESS,HELP,SEQ) ;
N HTXT
;S CNT=CNT+1,HTXT(CNT)=""
I HELP<5 S HTXT(1)="The "_$G(EXT)_" "_$G(NAME)_" branching logic sequence #"_$G(SEQ)
I HELP=1 S HTXT(1)=HTXT(1)_" can only have a value of 'T' or 'F' for a Reminder Term."
I HELP=2 S HTXT(1)=HTXT(1)_" can only have a value of 'A','D' or 'N' for a Reminder Definition."
I HELP=3 S HTXT(1)=HTXT(1)_" is using duplicate evaluation status for a Reminder Definition."
I HELP=4 S HTXT(1)=HTXT(1)_" is using duplicate evaluation status for a Reminder Term."
I HELP=5 D
.S CNT=CNT+1,HTXT(1)="The "_$G(EXT)_" "_$G(NAME)_" is using all possible evaluation statuses for an evaluation item."
.S CNT=CNT+1,HTXT(2)="Please verified the dialog "_$G(EXT)_" is working as expected."
D BUILDMSG^PXRMDLRP(.HTXT,.CNT,.MESS,1)
Q
;
RECCHK(IEN,DIEN) ;
N REPIEN,FOUND,IDX
S FOUND=0
I $D(^PXRMD(801.41,"BLR",IEN,DIEN)) Q 1
I $P($G(^PXRMD(801.41,DIEN,0)),U,4)="G",$$VGROUP^PXRMDD41(DIEN,IEN)=1 Q 1
S IDX=0 F S IDX=$O(^PXRMD(801.41,DIEN,"BL",IDX)) Q:IDX'>0!(FOUND) D
.S REPIEN=$P($G(^PXRMD(801.41,DIEN,"BL",IDX,0)),U,5) I REPIEN'>0 Q
.I $$RECCHK(IEN,REPIEN)=1 S FOUND=1 Q
.I $P($G(^PXRMD(801.41,REPIEN,0)),U,4)="G",$$VGROUP^PXRMDD41(REPIEN,IEN)=1 S FOUND=1 Q
Q FOUND
;
SCREEN(IEN,DIEN) ;
N NODE,TEMPARR
I IEN(1)=DIEN Q 0
S NODE=$G(^PXRMD(801.41,DIEN,0))
I +$P(NODE,U,3)>0 Q 0
I "EG"'[$P(NODE,U,4) Q 0
I $$RECCHK(IEN(1),DIEN)=1 Q 0
I $$REPCHK(DIEN,IEN(1))=1 Q 0
Q 1
;
REPCHK(IEN,DIEN) ;
N FOUND,SIEN
S FOUND=0
I $P($G(^PXRMD(801.41,IEN,0)),U,4)="G",$$VGROUP^PXRMDD41(IEN,DIEN)=1 S FOUND=1 Q
S SIEN=0 F S SIEN=$O(^PXRMD(801.41,"BLR",DIEN,SIEN)) Q:SIEN'>0!(FOUND) D
.I $P($G(^PXRMD(801.41,IEN,0)),U,4)="G",$$VGROUP^PXRMDD41(IEN,SIEN)=1 S FOUND=1 Q
.I $D(^PXRMD(801.41,"BLR",SIEN)) I $$REPCHK(IEN,SIEN)=1 S FOUND=1 Q
Q FOUND
;
VALIDREM(NAME,TYPE,ITEM,ERRCNT,ERRMSG,FAIL) ;
N GBL,IEN,OUTPUT
S GBL=$P(ITEM,";",2)
S IEN=+ITEM
I GBL["811.5",'$$TERM^PXRMICK1(IEN,.OUTPUT,0) D Q
.D BUILDMSG^PXRMDLRP(.OUTPUT,.ERRCNT,.ERRMSG,$O(OUTPUT(""),-1))
.I $G(FAIL)'="F" S FAIL="F"
I GBL["811.9",'$$DEF^PXRMICHK(IEN,.OUTPUT,0) D
.D BUILDMSG^PXRMDLRP(.OUTPUT,.ERRCNT,.ERRMSG,$O(OUTPUT(""),-1))
.I $G(FAIL)'="F" S FAIL="F"
Q
;
WRITE(NODE) ;
N ITEM,STATUS,ACT
S ITEM=$P(NODE,U,2)
S ITEM=$S(ITEM["811.9":"RD."_$P($G(^PXD(811.9,+ITEM,0)),U),ITEM["811.5":"TM."_$P($G(^PXRMD(811.5,+ITEM,0)),U),1:ITEM)
S ACT=$P(NODE,U,4)
S ACT=$S(ACT="H":"HIDE",ACT="R":"REPLACE",ACT="C":"CHECK CHECKBOX",ACT="S":"SUPPRESS CHECKBOX",1:ACT)
D EN^DDIOL(ITEM_$J(" ",5)_ACT,,"?5")
Q
;
XHELP(IDS) ; executable help for branching logic
;
N DONE,IND,TEXT,TYPE
S DONE=0
F IND=1:1 Q:DONE D
. S TEXT=$P($T(TEXT+IND),";",3)
. I TEXT["**End Text**" S DONE=1 Q
. W !,TEXT
;
I $P($G(^PXRMD(801.41,IDS(1),0)),U,4)="G" D Q
.F TYPE="TEXT1","TEXT2" D
..S DONE=0
..F IND=1:1 Q:DONE D
... S TEXT=$P($T(@TYPE+IND),";",3)
... I TEXT["**End Text**" S DONE=1 Q
... W !,TEXT
;
S DONE=0
F IND=1:1 Q:DONE D
. S TEXT=$P($T(@TEXT1+IND),";",3)
. I TEXT["**End Text**" S DONE=1 Q
. W !,TEXT
Q
;
TEXT ;
;;This field is used to set what action should take effect
;;if the branching logic sequence is true. The available actions are:
;;
;;**End Text**
Q
;
TEXT1 ;
;;HIDE: This will make it so the current element or group will not show
;;in dialog.
;;
;;REPLACE: This will replace the current element or group with the value
;;in the REPLACMENT ITEM field.
;;
;;CHECK CHECKBOX: This will automatically check the current element or
;;group corresponding checkbox.
;;
;;SUPPRESS CHECKBOX: This will automatically suppress the current element
;;or group corresponding checkbox.
;;
;;**End Text**
Q
;
TEXT2 ;
;;1: indicates that only one element in the dialog group may be selected.
;;
;;2: indicates that one or more elements must be selected.
;;
;;3: indicates that either none or one selection is required.
;;
;;4: indicates all selections are required.
;;
;;0: or null indicates no selection required.
;;
;;**End Text**
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDBL 8876 printed Dec 13, 2024@01:43:31 Page 2
PXRMDBL ;SLC/AGP - Reminder Dialog Field editor/List Manager Tester ;07/31/2020
+1 ;;2.0;CLINICAL REMINDERS;**45,42**;Feb 04, 2005;Build 245
+2 ;
ACTION(IDS,Y) ;
+1 IF $GET(PXRMINST)=1
QUIT 1
+2 IF $GET(PXRMEXCH)=1
QUIT 1
+3 IF +$GET(IDS(1))'>0
QUIT 0
+4 IF +$GET(IDS)'>0
QUIT 0
+5 IF Y="H"!(Y="HIDE")
QUIT 1
+6 IF Y="R"!(Y="REPLACE")
QUIT 1
+7 IF Y="S"!(Y["SUPPRESS")
QUIT 1
+8 IF Y="C"!(Y="CHECK CHECKBOX")
QUIT 1
+9 IF $PIECE($GET(^PXRMD(801.41,IDS(1),0)),U,4)="G"&(Y="0"!(+Y>0)!(Y["SELECTION"))
QUIT 1
+10 QUIT 0
+11 ;
BUILDTXT(CNT,MESS,NAME,EXT,PIECE,SEQ) ;
+1 NEW ERR
+2 SET ERR(1)="The "_EXT_" "_NAME_" branching logic sequence #"_SEQ_" field "_$SELECT(PIECE=1:"Sequence",PIECE=2:"Evaluation Item",PIECE=3:"Evaluation Status",PIECE=4:"Action",PIECE=5:"Replacement Item",1:"")_" is missing a value."
+3 DO BUILDMSG^PXRMDLRP(.ERR,.CNT,.MESS,1)
+4 QUIT
+5 ;
CHECK1(DIEN,NAME,EXT,CNT,ERR,FAIL) ;
+1 NEW I,IEN,J,NODE,SEQ,TEMP,TYPE,VALID
+2 SET VALID=""
+3 SET TYPE=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U,4)
+4 SET IEN=0
FOR
SET IEN=$ORDER(^PXRMD(801.41,DIEN,"BL",IEN))
if IEN'>0!(VALID="F")
QUIT
Begin DoDot:1
+5 SET NODE=$GET(^PXRMD(801.41,DIEN,"BL",IEN,0))
+6 FOR I=.01,1,2,3
Begin DoDot:2
+7 SET SEQ=$PIECE(NODE,U)
+8 ;at least first three field must be defined
+9 IF I=.01
FOR J=1,2,3
Begin DoDot:3
+10 IF $PIECE(NODE,U,J+1)=""
SET VALID="F"
DO BUILDTXT(.CNT,.ERR,NAME,EXT,J+1,SEQ)
End DoDot:3
if VALID="F"
QUIT
+11 ;if eval item, status and action must be defined
+12 IF I=1
FOR J=2,3
Begin DoDot:3
+13 IF $PIECE(NODE,U,J+1)=""
SET VALID="F"
DO BUILDTXT(.CNT,.ERR,NAME,EXT,J+1,SEQ)
End DoDot:3
if VALID'=""
QUIT
+14 ;if status action must be defined
+15 IF I=2
IF $PIECE(NODE,U,4)=""
SET VALID="F"
DO BUILDTXT(.CNT,.ERR,NAME,EXT,4,SEQ)
QUIT
+16 IF I=3
Begin DoDot:3
+17 ;if action is repl dialog must be defined
+18 IF $PIECE(NODE,U,4)="R"
IF $PIECE(NODE,U,5)'>0
SET VALID="F"
DO BUILDTXT(.CNT,.ERR,NAME,EXT,5,SEQ)
QUIT
+19 IF $PIECE(NODE,U,4)="0"!(+$PIECE(NODE,U,4)>0)
Begin DoDot:4
+20 IF TYPE'="G"
Begin DoDot:5
+21 SET TEMP(1)="The "_EXT_" "_NAME_" branching logic sequence #"_SEQ_" Evaluation Item is not a group."
+22 DO BUILDMSG^PXRMDLRP(.TEMP,.CNT,.ERR,1)
SET VALID="F"
End DoDot:5
End DoDot:4
End DoDot:3
QUIT
End DoDot:2
if VALID'=""
QUIT
+23 IF VALID'="F"
DO VALIDREM(NAME,EXT,$PIECE(NODE,U,2),.CNT,.ERR,.VALID)
End DoDot:1
+24 IF VALID="F"
GOTO CHECK1X
+25 DO CHCKEVST(DIEN,NAME,EXT,.CNT,.ERR,.VALID)
CHECK1X ;
+1 IF FAIL'="F"
SET FAIL=VALID
+2 QUIT
+3 ;
+4 ;
CHCKEVST(DIEN,NAME,EXT,CNT,ERR,FAIL) ;
+1 NEW ARRAY,DEFAULTS,EVALITEM,FOUND,IEN,IDX,ITEM,NODE,SEQ,TEMP,TYPE,NODE,STATUS
+2 SET DEFAULTS("TERM")=2
SET DEFAULTS("TERM","F")=""
SET DEFAULTS("TERM","T")=""
+3 SET DEFAULTS("DEF")=3
SET DEFAULTS("DEF","A")=""
SET DEFAULTS("DEF","D")=""
SET DEFAULTS("DEF","N")=""
+4 SET IEN=0
FOR
SET IEN=$ORDER(^PXRMD(801.41,DIEN,"BL",IEN))
if IEN'>0!(FAIL'="")
QUIT
Begin DoDot:1
+5 SET NODE=$GET(^PXRMD(801.41,DIEN,"BL",IEN,0))
+6 SET EVALITEM=$PIECE(NODE,U,2)
SET SEQ=$PIECE(NODE,U)
SET STATUS=$PIECE(NODE,U,3)
+7 SET TYPE=$SELECT(EVALITEM["811.5":"TERM",EVALITEM["811.9":"DEF",1:"UNK")
+8 IF TYPE="TERM"&(STATUS'="T"&(STATUS'="F"))
DO HELP(NAME,EXT,.CNT,.ERR,1,SEQ)
SET FAIL="F"
QUIT
+9 IF TYPE="DEF"&(STATUS'="D"&(STATUS'="A")&(STATUS'="N"))
DO HELP(NAME,EXT,.CNT,.ERR,2,SEQ)
SET FAIL="F"
QUIT
+10 ;CHECK FOR DUPLICATES
+11 IF $DATA(ARRAY(TYPE,EVALITEM,STATUS))
DO HELP(NAME,EXT,.ERR,$SELECT(EVALITEM["811.5":4,1:3),SEQ)
SET FAIL="F"
QUIT
+12 SET ARRAY(TYPE,EVALITEM,STATUS)=""
End DoDot:1
+13 ;loop through array of entries to check if every status is selected
+14 IF FAIL'=""
QUIT
+15 FOR TYPE="DEF","TERM"
Begin DoDot:1
+16 SET ITEM=0
FOR
SET ITEM=$ORDER(ARRAY(TYPE,ITEM))
if ITEM'>0!(FAIL'="")
QUIT
Begin DoDot:2
+17 ;reset default list
+18 MERGE TEMP=DEFAULTS
+19 SET STATUS=""
FOR
SET STATUS=$ORDER(ARRAY(TYPE,ITEM,STATUS))
if STATUS=""
QUIT
Begin DoDot:3
+20 IF $DATA(TEMP(TYPE,STATUS))
KILL TEMP(TYPE,STATUS)
SET TEMP(TYPE)=TEMP(TYPE)-1
End DoDot:3
+21 ;I $D(TEMP(TYPE,STATUS)) K TEMP(TYPE,STATUS) S TEMP(TYPE)=TEMP(TYPE)-1
+22 IF TEMP(TYPE)<1
DO HELP(NAME,EXT,.CNT,.ERR,5,SEQ)
SET FAIL="W"
End DoDot:2
End DoDot:1
+23 QUIT
+24 ;
CHECKITM(DA,VALUE) ;
+1 NEW IENS,NODE
+2 SET IENS=DA_","_DA(1)_","
+3 SET NODE=$GET(^PXRMD(801.41,DA(1),"BL",DA,0))
+4 IF VALUE=""
IF $PIECE(NODE,U)>0
DO DELFIELD(IENS,801.41143,.01)
QUIT 0
+5 QUIT 1
+6 ;
DELFIELD(IENS,SUB,FIELD) ;Delete a field.
+1 NEW FDA,MSG
+2 SET FDA(SUB,IENS,FIELD)="@"
+3 DO FILE^DIE("","FDA","MSG")
+4 IF $DATA(MSG)
WRITE !,"Error in delete",!
DO AWRITE^PXRMUTIL("MSG")
+5 QUIT
+6 ;
DELREPL(DA,FIELD,OLD,NEW) ;
+1 NEW IENS,X
+2 IF OLD=""
QUIT
+3 SET IENS=DA_","_DA(1)_","
+4 ;I FIELD=.01,NEW="" F X=1,2,3,4 D DELFIELD(IENS,801.41143,X)
+5 IF FIELD=1
IF $PIECE(OLD,";",2)'=$PIECE(NEW,";",2)
Begin DoDot:1
+6 FOR X=2,3,4
DO DELFIELD(IENS,801.41143,X)
+7 ;I NEW="",+$P($G(^PXRMD(801.41,DA(1),"BL",DA,0)),U)>0 D DELFIELD(IENS,801.41143,.01)
End DoDot:1
+8 IF FIELD=2
IF NEW=""
FOR X=3,4
DO DELFIELD(IENS,801.41143,X)
+9 IF FIELD=3
IF $GET(OLD)="R"
IF $GET(NEW)'="R"
DO DELFIELD(IENS,801.41143,4)
+10 IF FIELD=3
IF NEW=""
DO DELFIELD(IENS,801.41143,X)
+11 QUIT
+12 ;
EVALSTAT(IDS,Y) ;
+1 NEW ISTERM,NODE
+2 IF $GET(PXRMINST)=1
QUIT 1
+3 IF $GET(PXRMEXCH)=1
QUIT 1
+4 IF +$GET(IDS(1))'>0
QUIT 0
+5 IF +$GET(IDS)'>0
QUIT 0
+6 SET NODE=$GET(^PXRMD(801.41,IDS(1),"BL",IDS,0))
IF NODE=""
QUIT 0
+7 SET ISTERM=$SELECT($PIECE(NODE,U,2)[811.5:1,1:0)
+8 IF ISTERM=1&(Y="F"!(Y="T"))!(Y="TRUE")!(Y="FALSE")
QUIT 1
+9 IF ISTERM=0&(Y="D"!(Y="A")!(Y="N"))!(Y="DUE")!(Y="APPLICABLE")!(Y="N/A")
QUIT 1
+10 QUIT 0
+11 ;
HELP(NAME,EXT,CNT,MESS,HELP,SEQ) ;
+1 NEW HTXT
+2 ;S CNT=CNT+1,HTXT(CNT)=""
+3 IF HELP<5
SET HTXT(1)="The "_$GET(EXT)_" "_$GET(NAME)_" branching logic sequence #"_$GET(SEQ)
+4 IF HELP=1
SET HTXT(1)=HTXT(1)_" can only have a value of 'T' or 'F' for a Reminder Term."
+5 IF HELP=2
SET HTXT(1)=HTXT(1)_" can only have a value of 'A','D' or 'N' for a Reminder Definition."
+6 IF HELP=3
SET HTXT(1)=HTXT(1)_" is using duplicate evaluation status for a Reminder Definition."
+7 IF HELP=4
SET HTXT(1)=HTXT(1)_" is using duplicate evaluation status for a Reminder Term."
+8 IF HELP=5
Begin DoDot:1
+9 SET CNT=CNT+1
SET HTXT(1)="The "_$GET(EXT)_" "_$GET(NAME)_" is using all possible evaluation statuses for an evaluation item."
+10 SET CNT=CNT+1
SET HTXT(2)="Please verified the dialog "_$GET(EXT)_" is working as expected."
End DoDot:1
+11 DO BUILDMSG^PXRMDLRP(.HTXT,.CNT,.MESS,1)
+12 QUIT
+13 ;
RECCHK(IEN,DIEN) ;
+1 NEW REPIEN,FOUND,IDX
+2 SET FOUND=0
+3 IF $DATA(^PXRMD(801.41,"BLR",IEN,DIEN))
QUIT 1
+4 IF $PIECE($GET(^PXRMD(801.41,DIEN,0)),U,4)="G"
IF $$VGROUP^PXRMDD41(DIEN,IEN)=1
QUIT 1
+5 SET IDX=0
FOR
SET IDX=$ORDER(^PXRMD(801.41,DIEN,"BL",IDX))
if IDX'>0!(FOUND)
QUIT
Begin DoDot:1
+6 SET REPIEN=$PIECE($GET(^PXRMD(801.41,DIEN,"BL",IDX,0)),U,5)
IF REPIEN'>0
QUIT
+7 IF $$RECCHK(IEN,REPIEN)=1
SET FOUND=1
QUIT
+8 IF $PIECE($GET(^PXRMD(801.41,REPIEN,0)),U,4)="G"
IF $$VGROUP^PXRMDD41(REPIEN,IEN)=1
SET FOUND=1
QUIT
End DoDot:1
+9 QUIT FOUND
+10 ;
SCREEN(IEN,DIEN) ;
+1 NEW NODE,TEMPARR
+2 IF IEN(1)=DIEN
QUIT 0
+3 SET NODE=$GET(^PXRMD(801.41,DIEN,0))
+4 IF +$PIECE(NODE,U,3)>0
QUIT 0
+5 IF "EG"'[$PIECE(NODE,U,4)
QUIT 0
+6 IF $$RECCHK(IEN(1),DIEN)=1
QUIT 0
+7 IF $$REPCHK(DIEN,IEN(1))=1
QUIT 0
+8 QUIT 1
+9 ;
REPCHK(IEN,DIEN) ;
+1 NEW FOUND,SIEN
+2 SET FOUND=0
+3 IF $PIECE($GET(^PXRMD(801.41,IEN,0)),U,4)="G"
IF $$VGROUP^PXRMDD41(IEN,DIEN)=1
SET FOUND=1
QUIT
+4 SET SIEN=0
FOR
SET SIEN=$ORDER(^PXRMD(801.41,"BLR",DIEN,SIEN))
if SIEN'>0!(FOUND)
QUIT
Begin DoDot:1
+5 IF $PIECE($GET(^PXRMD(801.41,IEN,0)),U,4)="G"
IF $$VGROUP^PXRMDD41(IEN,SIEN)=1
SET FOUND=1
QUIT
+6 IF $DATA(^PXRMD(801.41,"BLR",SIEN))
IF $$REPCHK(IEN,SIEN)=1
SET FOUND=1
QUIT
End DoDot:1
+7 QUIT FOUND
+8 ;
VALIDREM(NAME,TYPE,ITEM,ERRCNT,ERRMSG,FAIL) ;
+1 NEW GBL,IEN,OUTPUT
+2 SET GBL=$PIECE(ITEM,";",2)
+3 SET IEN=+ITEM
+4 IF GBL["811.5"
IF '$$TERM^PXRMICK1(IEN,.OUTPUT,0)
Begin DoDot:1
+5 DO BUILDMSG^PXRMDLRP(.OUTPUT,.ERRCNT,.ERRMSG,$ORDER(OUTPUT(""),-1))
+6 IF $GET(FAIL)'="F"
SET FAIL="F"
End DoDot:1
QUIT
+7 IF GBL["811.9"
IF '$$DEF^PXRMICHK(IEN,.OUTPUT,0)
Begin DoDot:1
+8 DO BUILDMSG^PXRMDLRP(.OUTPUT,.ERRCNT,.ERRMSG,$ORDER(OUTPUT(""),-1))
+9 IF $GET(FAIL)'="F"
SET FAIL="F"
End DoDot:1
+10 QUIT
+11 ;
WRITE(NODE) ;
+1 NEW ITEM,STATUS,ACT
+2 SET ITEM=$PIECE(NODE,U,2)
+3 SET ITEM=$SELECT(ITEM["811.9":"RD."_$PIECE($GET(^PXD(811.9,+ITEM,0)),U),ITEM["811.5":"TM."_$PIECE($GET(^PXRMD(811.5,+ITEM,0)),U),1:ITEM)
+4 SET ACT=$PIECE(NODE,U,4)
+5 SET ACT=$SELECT(ACT="H":"HIDE",ACT="R":"REPLACE",ACT="C":"CHECK CHECKBOX",ACT="S":"SUPPRESS CHECKBOX",1:ACT)
+6 DO EN^DDIOL(ITEM_$JUSTIFY(" ",5)_ACT,,"?5")
+7 QUIT
+8 ;
XHELP(IDS) ; executable help for branching logic
+1 ;
+2 NEW DONE,IND,TEXT,TYPE
+3 SET DONE=0
+4 FOR IND=1:1
if DONE
QUIT
Begin DoDot:1
+5 SET TEXT=$PIECE($TEXT(TEXT+IND),";",3)
+6 IF TEXT["**End Text**"
SET DONE=1
QUIT
+7 WRITE !,TEXT
End DoDot:1
+8 ;
+9 IF $PIECE($GET(^PXRMD(801.41,IDS(1),0)),U,4)="G"
Begin DoDot:1
+10 FOR TYPE="TEXT1","TEXT2"
Begin DoDot:2
+11 SET DONE=0
+12 FOR IND=1:1
if DONE
QUIT
Begin DoDot:3
+13 SET TEXT=$PIECE($TEXT(@TYPE+IND),";",3)
+14 IF TEXT["**End Text**"
SET DONE=1
QUIT
+15 WRITE !,TEXT
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+16 ;
+17 SET DONE=0
+18 FOR IND=1:1
if DONE
QUIT
Begin DoDot:1
+19 SET TEXT=$PIECE($TEXT(@TEXT1+IND),";",3)
+20 IF TEXT["**End Text**"
SET DONE=1
QUIT
+21 WRITE !,TEXT
End DoDot:1
+22 QUIT
+23 ;
TEXT ;
+1 ;;This field is used to set what action should take effect
+2 ;;if the branching logic sequence is true. The available actions are:
+3 ;;
+4 ;;**End Text**
+5 QUIT
+6 ;
TEXT1 ;
+1 ;;HIDE: This will make it so the current element or group will not show
+2 ;;in dialog.
+3 ;;
+4 ;;REPLACE: This will replace the current element or group with the value
+5 ;;in the REPLACMENT ITEM field.
+6 ;;
+7 ;;CHECK CHECKBOX: This will automatically check the current element or
+8 ;;group corresponding checkbox.
+9 ;;
+10 ;;SUPPRESS CHECKBOX: This will automatically suppress the current element
+11 ;;or group corresponding checkbox.
+12 ;;
+13 ;;**End Text**
+14 QUIT
+15 ;
TEXT2 ;
+1 ;;1: indicates that only one element in the dialog group may be selected.
+2 ;;
+3 ;;2: indicates that one or more elements must be selected.
+4 ;;
+5 ;;3: indicates that either none or one selection is required.
+6 ;;
+7 ;;4: indicates all selections are required.
+8 ;;
+9 ;;0: or null indicates no selection required.
+10 ;;
+11 ;;**End Text**
+12 QUIT
+13 ;
