PXRMDLST ; SLC/PJH - Reminder Dialog Inquiry ;07/31/2009
;;2.0;CLINICAL REMINDERS;**12**;Feb 04, 2005;Build 73
;
;
START N BY,DC,DHD,DIC,EXPAND,FLDS,FR,L,LIT,LOGIC,NOW,TO,Y
N PXRMFIEN,PXRMHD
;
S LIT="ALL DIALOGS"
I PXRMDTYP="R" S LIT="REMINDER DIALOGS"
I PXRMDTYP="P" S LIT="DIALOG PROMPTS"
I PXRMDTYP="F" S LIT="DIALOG FORCED VALUES"
I PXRMDTYP="E" S LIT="DIALOG ELEMENTS"
I PXRMDTYP="G" S LIT="DIALOG GROUPS"
;
;DIC is killed by DIP.
SELECT S DIC="^PXRMD(801.41,"
S DIC(0)="AEMQ"
S DIC("A")="Select Dialog Definition: "
;Current dialog type only
S DIC("S")="I $P(^(0),U,4)=PXRMDTYP"
D ^DIC
I Y'=-1 D G SELECT
.;^DIP options
.D SET
.D DISP
END Q
;
;List all (for protocol PXRM SELECTION LIST)
;--------
ALL N BY,DC,DHD,DIC,DIS,FLDS,FR,L,LIT,LOGIC,NOW,TO,Y
S LIT="ALL DIALOGS"
I PXRMDTYP="R" S LIT="REMINDER DIALOGS"
I PXRMDTYP="P" S LIT="DIALOG PROMPTS"
I PXRMDTYP="E" S LIT="DIALOG ELEMENTS"
I PXRMDTYP="G" S LIT="DIALOG GROUPS"
I PXRMDTYP="F" S LIT="DIALOG FORCED VALUES"
I $G(PXRMGTYP)="DLG" S LIT="REMINDER DIALOGS"
S Y=1
D SET
S DIC="^PXRMD(801.41,"
;
I PXRMDTYP'="A" S DIS(0)="I $P($G(^PXRMD(801.41,D0,0)),U,4)=PXRMDTYP"
S BY=".01"
S FR=""
S TO=""
S DHD="W ?0 D HED^PXRMDLST"
D DISP
Q
;
;Inquire/Print Option (for protocol PXRM GENERAL INQUIRE/PRINT)
;--------------------
INQ(Y) N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,NOW,TO
S DIC="^PXRMD(801.41,"
S DIC(0)="AEMQ"
D SET
D DISP
Q
;
;Inquiry/Print for dialog edit (for protocol PXRM DIALOG SELECTION INQ)
;-----------------------------
INQ1 W IORESET
D START
Q
;
;
;Display using print templates
;-----------------------------
DISP S L=0,FLDS="[PXRM REMINDER DIALOG]"
I PXRMDTYP="E" S FLDS="[PXRM DIALOG ELEMENT]"
I PXRMDTYP="F" S FLDS="[PXRM DIALOG FORCED VALUE]"
I PXRMDTYP="G" S FLDS="[PXRM DIALOG GROUP]"
I PXRMDTYP="P" S FLDS="[PXRM DIALOG PROMPT]"
I PXRMDTYP="S" S FLDS="[PXRM RESULT GROUP]"
I PXRMDTYP="T" S FLDS="[PXRM RESULT ELEMENT]"
;
D EN1^DIP
Q
;
;Header
;------
HED N TEMP,TEXTLEN,TEXTHED,TEXTUND
S TEXTHED="REMINDER DIALOG INQUIRY"
S TEXTUND=$TR($J("",IOM)," ","-")
S TEMP=NOW_" Page "_DC
S TEXTLEN=$L(TEMP)
W TEXTHED
W ?(IOM-TEXTLEN),TEMP
W !,TEXTUND,!!
Q
;
;Get question text
;-----------------
PROMPT N DTYP,FIRST,NODE,SUB,LINE,TAB
S SUB=$P(X,U,2) Q:SUB=""
S DTYP=$P($G(^PXRMD(801.41,SUB,0)),U,4) Q:DTYP=""
;Dialog element
I DTYP="E" D Q
.S NODE=0,FIRST=1,TAB=26
.F S NODE=$O(^PXRMD(801.41,SUB,25,NODE)) Q:'NODE D
..S LINE=$G(^PXRMD(801.41,SUB,25,NODE,0))
..I 'FIRST W !
..I FIRST,$L(LINE)>50 W ! S TAB=2
..W ?TAB,LINE
;Prompt/Forced Value
I "FP"[DTYP W $P($G(^PXRMD(801.41,SUB,2)),U,4)
Q
;
SET ;Setup all the variables
; Set Date for Header
S NOW=$$NOW^XLFDT
S NOW=$$FMTE^XLFDT(NOW,"1P")
;
;These variables need to be setup every time because DIP kills them.
S BY="NUMBER"
S (FR,TO)=+$P(Y,U,1)
S DHD="W ?0 D HED^PXRMDLST"
;
Q
;
;Orderable item
;--------------
ORDER I '$G(D0) Q
N QNAM,QORDER,RIEN,RNAM
S RIEN=$P($G(^PXRMD(801.41,D0,1)),U,3),RNAM=""
I RIEN S RNAM=$P($G(^PXRMD(801.9,RIEN,0)),U)
I RNAM'="ORDERED" W ?24,"N/A" Q
S QORDER=$P($G(^PXRMD(801.41,D0,1)),U,7)
I 'QORDER W ?24,"None" Q
S QNAM=$P($G(^ORD(101.43,QORDER,0)),U) I QNAM="" S QNAM="Unknown"
W ?24,QNAM," (OI["_QORDER_"])"
Q
;
;Dialog ELEMENT pointed to by REMINDER DIALOGS/GROUPS
;"AGP NO LONGER USED REPLACE BY USE"
;----------------------------------------------------
REPLACE(DIEN,TAB,CUR) ;
Q:'$G(DIEN)
N DATA,DSUB,DENAM,DETYP,DTLIT,DMES
S DSUB=0
F S DSUB=$O(^PXRMD(801.41,"R",DIEN,DSUB)) Q:'DSUB D
.S DATA=$G(^PXRMD(801.41,DSUB,0)) Q:DATA=""
.S DENAM=$P(DATA,U) Q:DENAM=""
.S DETYP=$P(DATA,U,4) Q:DETYP=""
.S DTLIT="??",DMES="" S:CUR=DSUB DMES="Current "
.I DETYP="G" S DTLIT="Dialog Group"
.I DETYP="E" S DTLIT="Dialog Element"
.W ?TAB,DENAM_" ("_DMES_DTLIT_")",!
Q
;
USE(DIEN,TAB,CUR,XREF) ;
Q:'$G(DIEN)
N DATA,DSUB,DENAM,DETYP,DTLIT,DMES
S DSUB=0
F S DSUB=$O(^PXRMD(801.41,XREF,DIEN,DSUB)) Q:'DSUB D
.S DATA=$G(^PXRMD(801.41,DSUB,0)) Q:DATA=""
.S DENAM=$P(DATA,U) Q:DENAM=""
.S DETYP=$P(DATA,U,4) Q:DETYP=""
.S DTLIT="??",DMES="" S:CUR=DSUB DMES="Current "
.I DETYP="R" S DTLIT="Reminder Dialog"
.I DETYP="G" S DTLIT="Dialog Group"
.I DETYP="E" S DTLIT="Dialog Element"
.I DETYP="S" S DTLIT="Result Group"
.W ?TAB,DENAM_" ("_DMES_DTLIT_")",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDLST 4510 printed Sep 02, 2024@18:29:33 Page 2
PXRMDLST ; SLC/PJH - Reminder Dialog Inquiry ;07/31/2009
+1 ;;2.0;CLINICAL REMINDERS;**12**;Feb 04, 2005;Build 73
+2 ;
+3 ;
START NEW BY,DC,DHD,DIC,EXPAND,FLDS,FR,L,LIT,LOGIC,NOW,TO,Y
+1 NEW PXRMFIEN,PXRMHD
+2 ;
+3 SET LIT="ALL DIALOGS"
+4 IF PXRMDTYP="R"
SET LIT="REMINDER DIALOGS"
+5 IF PXRMDTYP="P"
SET LIT="DIALOG PROMPTS"
+6 IF PXRMDTYP="F"
SET LIT="DIALOG FORCED VALUES"
+7 IF PXRMDTYP="E"
SET LIT="DIALOG ELEMENTS"
+8 IF PXRMDTYP="G"
SET LIT="DIALOG GROUPS"
+9 ;
+10 ;DIC is killed by DIP.
SELECT SET DIC="^PXRMD(801.41,"
+1 SET DIC(0)="AEMQ"
+2 SET DIC("A")="Select Dialog Definition: "
+3 ;Current dialog type only
+4 SET DIC("S")="I $P(^(0),U,4)=PXRMDTYP"
+5 DO ^DIC
+6 IF Y'=-1
Begin DoDot:1
+7 ;^DIP options
+8 DO SET
+9 DO DISP
End DoDot:1
GOTO SELECT
END QUIT
+1 ;
+2 ;List all (for protocol PXRM SELECTION LIST)
+3 ;--------
ALL NEW BY,DC,DHD,DIC,DIS,FLDS,FR,L,LIT,LOGIC,NOW,TO,Y
+1 SET LIT="ALL DIALOGS"
+2 IF PXRMDTYP="R"
SET LIT="REMINDER DIALOGS"
+3 IF PXRMDTYP="P"
SET LIT="DIALOG PROMPTS"
+4 IF PXRMDTYP="E"
SET LIT="DIALOG ELEMENTS"
+5 IF PXRMDTYP="G"
SET LIT="DIALOG GROUPS"
+6 IF PXRMDTYP="F"
SET LIT="DIALOG FORCED VALUES"
+7 IF $GET(PXRMGTYP)="DLG"
SET LIT="REMINDER DIALOGS"
+8 SET Y=1
+9 DO SET
+10 SET DIC="^PXRMD(801.41,"
+11 ;
+12 IF PXRMDTYP'="A"
SET DIS(0)="I $P($G(^PXRMD(801.41,D0,0)),U,4)=PXRMDTYP"
+13 SET BY=".01"
+14 SET FR=""
+15 SET TO=""
+16 SET DHD="W ?0 D HED^PXRMDLST"
+17 DO DISP
+18 QUIT
+19 ;
+20 ;Inquire/Print Option (for protocol PXRM GENERAL INQUIRE/PRINT)
+21 ;--------------------
INQ(Y) NEW BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,NOW,TO
+1 SET DIC="^PXRMD(801.41,"
+2 SET DIC(0)="AEMQ"
+3 DO SET
+4 DO DISP
+5 QUIT
+6 ;
+7 ;Inquiry/Print for dialog edit (for protocol PXRM DIALOG SELECTION INQ)
+8 ;-----------------------------
INQ1 WRITE IORESET
+1 DO START
+2 QUIT
+3 ;
+4 ;
+5 ;Display using print templates
+6 ;-----------------------------
DISP SET L=0
SET FLDS="[PXRM REMINDER DIALOG]"
+1 IF PXRMDTYP="E"
SET FLDS="[PXRM DIALOG ELEMENT]"
+2 IF PXRMDTYP="F"
SET FLDS="[PXRM DIALOG FORCED VALUE]"
+3 IF PXRMDTYP="G"
SET FLDS="[PXRM DIALOG GROUP]"
+4 IF PXRMDTYP="P"
SET FLDS="[PXRM DIALOG PROMPT]"
+5 IF PXRMDTYP="S"
SET FLDS="[PXRM RESULT GROUP]"
+6 IF PXRMDTYP="T"
SET FLDS="[PXRM RESULT ELEMENT]"
+7 ;
+8 DO EN1^DIP
+9 QUIT
+10 ;
+11 ;Header
+12 ;------
HED NEW TEMP,TEXTLEN,TEXTHED,TEXTUND
+1 SET TEXTHED="REMINDER DIALOG INQUIRY"
+2 SET TEXTUND=$TRANSLATE($JUSTIFY("",IOM)," ","-")
+3 SET TEMP=NOW_" Page "_DC
+4 SET TEXTLEN=$LENGTH(TEMP)
+5 WRITE TEXTHED
+6 WRITE ?(IOM-TEXTLEN),TEMP
+7 WRITE !,TEXTUND,!!
+8 QUIT
+9 ;
+10 ;Get question text
+11 ;-----------------
PROMPT NEW DTYP,FIRST,NODE,SUB,LINE,TAB
+1 SET SUB=$PIECE(X,U,2)
if SUB=""
QUIT
+2 SET DTYP=$PIECE($GET(^PXRMD(801.41,SUB,0)),U,4)
if DTYP=""
QUIT
+3 ;Dialog element
+4 IF DTYP="E"
Begin DoDot:1
+5 SET NODE=0
SET FIRST=1
SET TAB=26
+6 FOR
SET NODE=$ORDER(^PXRMD(801.41,SUB,25,NODE))
if 'NODE
QUIT
Begin DoDot:2
+7 SET LINE=$GET(^PXRMD(801.41,SUB,25,NODE,0))
+8 IF 'FIRST
WRITE !
+9 IF FIRST
IF $LENGTH(LINE)>50
WRITE !
SET TAB=2
+10 WRITE ?TAB,LINE
End DoDot:2
End DoDot:1
QUIT
+11 ;Prompt/Forced Value
+12 IF "FP"[DTYP
WRITE $PIECE($GET(^PXRMD(801.41,SUB,2)),U,4)
+13 QUIT
+14 ;
SET ;Setup all the variables
+1 ; Set Date for Header
+2 SET NOW=$$NOW^XLFDT
+3 SET NOW=$$FMTE^XLFDT(NOW,"1P")
+4 ;
+5 ;These variables need to be setup every time because DIP kills them.
+6 SET BY="NUMBER"
+7 SET (FR,TO)=+$PIECE(Y,U,1)
+8 SET DHD="W ?0 D HED^PXRMDLST"
+9 ;
+10 QUIT
+11 ;
+12 ;Orderable item
+13 ;--------------
ORDER IF '$GET(D0)
QUIT
+1 NEW QNAM,QORDER,RIEN,RNAM
+2 SET RIEN=$PIECE($GET(^PXRMD(801.41,D0,1)),U,3)
SET RNAM=""
+3 IF RIEN
SET RNAM=$PIECE($GET(^PXRMD(801.9,RIEN,0)),U)
+4 IF RNAM'="ORDERED"
WRITE ?24,"N/A"
QUIT
+5 SET QORDER=$PIECE($GET(^PXRMD(801.41,D0,1)),U,7)
+6 IF 'QORDER
WRITE ?24,"None"
QUIT
+7 SET QNAM=$PIECE($GET(^ORD(101.43,QORDER,0)),U)
IF QNAM=""
SET QNAM="Unknown"
+8 WRITE ?24,QNAM," (OI["_QORDER_"])"
+9 QUIT
+10 ;
+11 ;Dialog ELEMENT pointed to by REMINDER DIALOGS/GROUPS
+12 ;"AGP NO LONGER USED REPLACE BY USE"
+13 ;----------------------------------------------------
REPLACE(DIEN,TAB,CUR) ;
+1 if '$GET(DIEN)
QUIT
+2 NEW DATA,DSUB,DENAM,DETYP,DTLIT,DMES
+3 SET DSUB=0
+4 FOR
SET DSUB=$ORDER(^PXRMD(801.41,"R",DIEN,DSUB))
if 'DSUB
QUIT
Begin DoDot:1
+5 SET DATA=$GET(^PXRMD(801.41,DSUB,0))
if DATA=""
QUIT
+6 SET DENAM=$PIECE(DATA,U)
if DENAM=""
QUIT
+7 SET DETYP=$PIECE(DATA,U,4)
if DETYP=""
QUIT
+8 SET DTLIT="??"
SET DMES=""
if CUR=DSUB
SET DMES="Current "
+9 IF DETYP="G"
SET DTLIT="Dialog Group"
+10 IF DETYP="E"
SET DTLIT="Dialog Element"
+11 WRITE ?TAB,DENAM_" ("_DMES_DTLIT_")",!
End DoDot:1
+12 QUIT
+13 ;
USE(DIEN,TAB,CUR,XREF) ;
+1 if '$GET(DIEN)
QUIT
+2 NEW DATA,DSUB,DENAM,DETYP,DTLIT,DMES
+3 SET DSUB=0
+4 FOR
SET DSUB=$ORDER(^PXRMD(801.41,XREF,DIEN,DSUB))
if 'DSUB
QUIT
Begin DoDot:1
+5 SET DATA=$GET(^PXRMD(801.41,DSUB,0))
if DATA=""
QUIT
+6 SET DENAM=$PIECE(DATA,U)
if DENAM=""
QUIT
+7 SET DETYP=$PIECE(DATA,U,4)
if DETYP=""
QUIT
+8 SET DTLIT="??"
SET DMES=""
if CUR=DSUB
SET DMES="Current "
+9 IF DETYP="R"
SET DTLIT="Reminder Dialog"
+10 IF DETYP="G"
SET DTLIT="Dialog Group"
+11 IF DETYP="E"
SET DTLIT="Dialog Element"
+12 IF DETYP="S"
SET DTLIT="Result Group"
+13 WRITE ?TAB,DENAM_" ("_DMES_DTLIT_")",!
End DoDot:1
+14 QUIT
