PXRMFIP ; SLC/PJH - Edit/Inquire Finding Item Parameters ;03/09/2000
;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
;
;General selection
START N DIC,PXRMGTYP,PXRMHD,Y
SELECT ;Get lists of finding types for display
N DEF,DEF1,DEF2 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)
S PXRMHD="Finding Item Parameters",PXRMFIP="",PXRMGTYP="FIP"
D START^PXRMSEL(PXRMHD,PXRMGTYP,"PXRMFIP")
;Should return a value
I PXRMFIP D G SELECT
.S PXRMHD="FINDING ITEM PARAMETER NAME:"
.;Listman option
.D START^PXRMGEN(PXRMHD,PXRMGTYP,PXRMFIP)
;
END Q
;
;List all finding item parameters (for protocol PXRM SELECTION LIST)
;--------------------------------
ALL N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,NOW,TO,Y
S Y=1
D SET
S DIC="^PXRMD(801.43,"
S BY=".01"
S FR=""
S TO=""
S DHD="W ?0 D HED^PXRMFIP"
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.43,"
S DIC(0)="AEMQ"
D SET
D DISP
Q
;
;Display Header (see DHD variable)
;--------------
HED N TEMP,TEXTLEN,TEXTHED,TEXTUND
S TEXTHED="FINDING ITEM PARAMETER LIST"
S TEXTUND=$TR($J("",IOM)," ","-")
S TEMP=NOW_" Page "_DC
S TEXTLEN=$L(TEMP)
W TEXTHED
W ?(IOM-TEXTLEN),TEMP
W !,TEXTUND,!!
Q
;
;DISPLAY (Display from FLDS array)
;-------
DISP S L=0,FLDS="[PXRM FINDING ITEM PARAMETERS]"
D EN1^DIP
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^PXRMFIP"
;
Q
;
;Build display for selected finding item parametr - Called from PXRMGEN
;----------------------------------------------------------------------
FIP(PXRMFIP) ;
N DATA,DDIS,DNAM,DIEN,DHED,DTYP,FDES,FDIS,FITEM,FGLOB,FLIT,FSUB,FTYP
N HED1,HED2,LCT,SUB
S VALMCNT=0 K ^TMP("PXRMGENS",$J),^TMP("PXRMGEN",$J)
;Format headings to include finding item parameter name
S DATA=$G(^PXRMD(801.43,PXRMFIP,0)),FDES=$P(DATA,U),FDIS=$P(DATA,U,3)
S HEADER=PXRMHD_" "_FDES_" ("_$S(FDIS:"DISABLED",1:"ENABLED")_")"
;Dialog ien
S DATA=$G(^PXRMD(801.43,PXRMFIP,0)),DIEN=$P(DATA,U,4)
;Finding Item
S FITEM=$P(DATA,U,2),FTYP=$P(FITEM,";",2),FSUB=$P(FITEM,";")
S FLIT="??",FDES=$P(DATA,U)
I FTYP]"" S FTYP=$G(DEF1(FTYP)) S:FTYP="" FTYP="??"
I FSUB,FTYP'="??" D
.S FLIT=FTYP_"("_FSUB_")",FGLOB=U_$P(FITEM,";",2)_FSUB_",0)"
.S FDES=$P($G(@FGLOB),U) I FDES="" S FDES="??"
S HED1="Finding Type: "_FLIT
S HED2="Finding Item: "_FDES
;Dialog details
I DIEN S DATA=$G(^PXRMD(801.41,DIEN,0))
;Unknown pointer
I ('DIEN)!(DATA="") D Q
.S VALMCNT=VALMCNT+1
.S ^TMP("PXRMGEN",$J,VALMCNT,0)="Bad Pointer to Dialog File"
.S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT
;Dialog type, name and disabled flag
S DTYP=$P(DATA,U,4)
S DHED=$S(DTYP="G":"Group",DTYP="E":"Element",1:"??")
;
;Dialog Element Details
I DTYP="E" D ELEMENT(DIEN,"")
;
;Dialog Group Details
I DTYP="G" D
.S DDIS=$P(DATA,U,3),DNAM=$P(DATA,U)
.S DNAM=DNAM_" ("_$S(DDIS:"DISABLED",1:"ENABLED")_")"
.S VALMCNT=VALMCNT+1
.S ^TMP("PXRMGEN",$J,VALMCNT,0)=$J("",79)
.S VALMCNT=VALMCNT+1
.S ^TMP("PXRMGEN",$J,VALMCNT,0)="Dialog Group: "_DNAM
.S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT
.;
.N DSEQ,EIEN,SUB S SUB=0
.;Loop through group for elements
.F S SUB=$O(^PXRMD(801.41,DIEN,10,SUB)) Q:'SUB D
..S DATA=$G(^PXRMD(801.41,DIEN,10,SUB,0)) Q:DATA=""
..S DSEQ=$P(DATA,U) Q:'DSEQ S EIEN=$P(DATA,U,2) Q:'EIEN
..;Save dialog elements in sequence order
..S ^TMP("PXRMGENS",$J,DSEQ)=EIEN
.;
.;Put the list into the array List Manager is using.
.S DSEQ="",LCT=0
.F S DSEQ=$O(^TMP("PXRMGENS",$J,DSEQ)) Q:DSEQ="" D
..S EIEN=$G(^TMP("PXRMGENS",$J,DSEQ)) Q:'EIEN
..D ELEMENT(EIEN,DSEQ)
.;Final linefeed
.S VALMCNT=VALMCNT+1
.S ^TMP("PXRMGEN",$J,VALMCNT,0)=$J("",79)
.S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT
;
K ^TMP("PXRMGENS",$J)
;Create headings
D CHGCAP^VALM("HEADER1",HED1)
D CHGCAP^VALM("HEADER2",HED2)
D CHGCAP^VALM("HEADER3","")
Q
;
;Dialog Element Details
;----------------------
ELEMENT(DIEN,DSEQ) ;
N DATA,DNAM,DDIS,DTXT,TSUB,TXT
S DATA=$G(^PXRMD(801.41,DIEN,0)) Q:DATA=""
S DDIS=$P(DATA,U,3),DNAM=$P(DATA,U)
S DNAM=DNAM_" ("_$S(DDIS:"DISABLED",1:"ENABLED")_")"
S TXT="Dialog Element: "_DNAM
I DSEQ S TXT=$J(DSEQ,2)_") "_TXT
I 'DSEQ S TXT=" "_TXT
S VALMCNT=VALMCNT+1
S ^TMP("PXRMGEN",$J,VALMCNT,0)=$J("",79)
S VALMCNT=VALMCNT+1
S ^TMP("PXRMGEN",$J,VALMCNT,0)=TXT
S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT
;Dialog Text
S TSUB=0,TXT=" Dialog Text: "
F S TSUB=$O(^PXRMD(801.41,DIEN,25,TSUB)) Q:'TSUB D
.S DTXT=$G(^PXRMD(801.41,DIEN,25,TSUB,0))
.S VALMCNT=VALMCNT+1
.S ^TMP("PXRMGEN",$J,VALMCNT,0)=TXT_DTXT
.S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT,TXT=$J("",17)
;Additional prompts/forced values
N ACNT,ADES,AIEN,ASUB,ATYP,DATA
S ASUB=0,ACNT=0,TXT=" Additional Prompts: "
F S ASUB=$O(^PXRMD(801.41,DIEN,10,ASUB)) Q:'ASUB D
.;Get prompt ien
.S AIEN=$P($G(^PXRMD(801.41,DIEN,10,ASUB,0)),U,2) Q:AIEN=""
.;Get description and type from dialog file
.S DATA=$G(^PXRMD(801.41,AIEN,0))
.S ADES=$P(DATA,U) I ADES="" S ADES=AIEN
.S ATYP="" I $P(DATA,U,4)="F" S ATYP=" (forced value)"
.S VALMCNT=VALMCNT+1,ACNT=ACNT+1
.S ^TMP("PXRMGEN",$J,VALMCNT,0)=TXT_ADES_ATYP,TXT=$J("",24)
.S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT
I ACNT=0 D
.S VALMCNT=VALMCNT+1,ACNT=ACNT+1
.S ^TMP("PXRMGEN",$J,VALMCNT,0)=TXT_"*NONE*"
.S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMFIP 5659 printed Nov 22, 2024@16:55:40 Page 2
PXRMFIP ; SLC/PJH - Edit/Inquire Finding Item Parameters ;03/09/2000
+1 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
+2 ;
+3 ;General selection
START NEW DIC,PXRMGTYP,PXRMHD,Y
SELECT ;Get lists of finding types for display
+1 NEW DEF,DEF1,DEF2
DO DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)
+2 SET PXRMHD="Finding Item Parameters"
SET PXRMFIP=""
SET PXRMGTYP="FIP"
+3 DO START^PXRMSEL(PXRMHD,PXRMGTYP,"PXRMFIP")
+4 ;Should return a value
+5 IF PXRMFIP
Begin DoDot:1
+6 SET PXRMHD="FINDING ITEM PARAMETER NAME:"
+7 ;Listman option
+8 DO START^PXRMGEN(PXRMHD,PXRMGTYP,PXRMFIP)
End DoDot:1
GOTO SELECT
+9 ;
END QUIT
+1 ;
+2 ;List all finding item parameters (for protocol PXRM SELECTION LIST)
+3 ;--------------------------------
ALL NEW BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,NOW,TO,Y
+1 SET Y=1
+2 DO SET
+3 SET DIC="^PXRMD(801.43,"
+4 SET BY=".01"
+5 SET FR=""
+6 SET TO=""
+7 SET DHD="W ?0 D HED^PXRMFIP"
+8 DO DISP
+9 QUIT
+10 ;
+11 ;Inquire/Print Option (for protocol PXRM GENERAL INQUIRE/PRINT)
+12 ;--------------------
INQ(Y) NEW BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,NOW,TO
+1 SET DIC="^PXRMD(801.43,"
+2 SET DIC(0)="AEMQ"
+3 DO SET
+4 DO DISP
+5 QUIT
+6 ;
+7 ;Display Header (see DHD variable)
+8 ;--------------
HED NEW TEMP,TEXTLEN,TEXTHED,TEXTUND
+1 SET TEXTHED="FINDING ITEM PARAMETER LIST"
+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 ;DISPLAY (Display from FLDS array)
+11 ;-------
DISP SET L=0
SET FLDS="[PXRM FINDING ITEM PARAMETERS]"
+1 DO EN1^DIP
+2 QUIT
+3 ;
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^PXRMFIP"
+9 ;
+10 QUIT
+11 ;
+12 ;Build display for selected finding item parametr - Called from PXRMGEN
+13 ;----------------------------------------------------------------------
FIP(PXRMFIP) ;
+1 NEW DATA,DDIS,DNAM,DIEN,DHED,DTYP,FDES,FDIS,FITEM,FGLOB,FLIT,FSUB,FTYP
+2 NEW HED1,HED2,LCT,SUB
+3 SET VALMCNT=0
KILL ^TMP("PXRMGENS",$JOB),^TMP("PXRMGEN",$JOB)
+4 ;Format headings to include finding item parameter name
+5 SET DATA=$GET(^PXRMD(801.43,PXRMFIP,0))
SET FDES=$PIECE(DATA,U)
SET FDIS=$PIECE(DATA,U,3)
+6 SET HEADER=PXRMHD_" "_FDES_" ("_$SELECT(FDIS:"DISABLED",1:"ENABLED")_")"
+7 ;Dialog ien
+8 SET DATA=$GET(^PXRMD(801.43,PXRMFIP,0))
SET DIEN=$PIECE(DATA,U,4)
+9 ;Finding Item
+10 SET FITEM=$PIECE(DATA,U,2)
SET FTYP=$PIECE(FITEM,";",2)
SET FSUB=$PIECE(FITEM,";")
+11 SET FLIT="??"
SET FDES=$PIECE(DATA,U)
+12 IF FTYP]""
SET FTYP=$GET(DEF1(FTYP))
if FTYP=""
SET FTYP="??"
+13 IF FSUB
IF FTYP'="??"
Begin DoDot:1
+14 SET FLIT=FTYP_"("_FSUB_")"
SET FGLOB=U_$PIECE(FITEM,";",2)_FSUB_",0)"
+15 SET FDES=$PIECE($GET(@FGLOB),U)
IF FDES=""
SET FDES="??"
End DoDot:1
+16 SET HED1="Finding Type: "_FLIT
+17 SET HED2="Finding Item: "_FDES
+18 ;Dialog details
+19 IF DIEN
SET DATA=$GET(^PXRMD(801.41,DIEN,0))
+20 ;Unknown pointer
+21 IF ('DIEN)!(DATA="")
Begin DoDot:1
+22 SET VALMCNT=VALMCNT+1
+23 SET ^TMP("PXRMGEN",$JOB,VALMCNT,0)="Bad Pointer to Dialog File"
+24 SET ^TMP("PXRMGEN",$JOB,"VALMCNT")=VALMCNT
End DoDot:1
QUIT
+25 ;Dialog type, name and disabled flag
+26 SET DTYP=$PIECE(DATA,U,4)
+27 SET DHED=$SELECT(DTYP="G":"Group",DTYP="E":"Element",1:"??")
+28 ;
+29 ;Dialog Element Details
+30 IF DTYP="E"
DO ELEMENT(DIEN,"")
+31 ;
+32 ;Dialog Group Details
+33 IF DTYP="G"
Begin DoDot:1
+34 SET DDIS=$PIECE(DATA,U,3)
SET DNAM=$PIECE(DATA,U)
+35 SET DNAM=DNAM_" ("_$SELECT(DDIS:"DISABLED",1:"ENABLED")_")"
+36 SET VALMCNT=VALMCNT+1
+37 SET ^TMP("PXRMGEN",$JOB,VALMCNT,0)=$JUSTIFY("",79)
+38 SET VALMCNT=VALMCNT+1
+39 SET ^TMP("PXRMGEN",$JOB,VALMCNT,0)="Dialog Group: "_DNAM
+40 SET ^TMP("PXRMGEN",$JOB,"VALMCNT")=VALMCNT
+41 ;
+42 NEW DSEQ,EIEN,SUB
SET SUB=0
+43 ;Loop through group for elements
+44 FOR
SET SUB=$ORDER(^PXRMD(801.41,DIEN,10,SUB))
if 'SUB
QUIT
Begin DoDot:2
+45 SET DATA=$GET(^PXRMD(801.41,DIEN,10,SUB,0))
if DATA=""
QUIT
+46 SET DSEQ=$PIECE(DATA,U)
if 'DSEQ
QUIT
SET EIEN=$PIECE(DATA,U,2)
if 'EIEN
QUIT
+47 ;Save dialog elements in sequence order
+48 SET ^TMP("PXRMGENS",$JOB,DSEQ)=EIEN
End DoDot:2
+49 ;
+50 ;Put the list into the array List Manager is using.
+51 SET DSEQ=""
SET LCT=0
+52 FOR
SET DSEQ=$ORDER(^TMP("PXRMGENS",$JOB,DSEQ))
if DSEQ=""
QUIT
Begin DoDot:2
+53 SET EIEN=$GET(^TMP("PXRMGENS",$JOB,DSEQ))
if 'EIEN
QUIT
+54 DO ELEMENT(EIEN,DSEQ)
End DoDot:2
+55 ;Final linefeed
+56 SET VALMCNT=VALMCNT+1
+57 SET ^TMP("PXRMGEN",$JOB,VALMCNT,0)=$JUSTIFY("",79)
+58 SET ^TMP("PXRMGEN",$JOB,"VALMCNT")=VALMCNT
End DoDot:1
+59 ;
+60 KILL ^TMP("PXRMGENS",$JOB)
+61 ;Create headings
+62 DO CHGCAP^VALM("HEADER1",HED1)
+63 DO CHGCAP^VALM("HEADER2",HED2)
+64 DO CHGCAP^VALM("HEADER3","")
+65 QUIT
+66 ;
+67 ;Dialog Element Details
+68 ;----------------------
ELEMENT(DIEN,DSEQ) ;
+1 NEW DATA,DNAM,DDIS,DTXT,TSUB,TXT
+2 SET DATA=$GET(^PXRMD(801.41,DIEN,0))
if DATA=""
QUIT
+3 SET DDIS=$PIECE(DATA,U,3)
SET DNAM=$PIECE(DATA,U)
+4 SET DNAM=DNAM_" ("_$SELECT(DDIS:"DISABLED",1:"ENABLED")_")"
+5 SET TXT="Dialog Element: "_DNAM
+6 IF DSEQ
SET TXT=$JUSTIFY(DSEQ,2)_") "_TXT
+7 IF 'DSEQ
SET TXT=" "_TXT
+8 SET VALMCNT=VALMCNT+1
+9 SET ^TMP("PXRMGEN",$JOB,VALMCNT,0)=$JUSTIFY("",79)
+10 SET VALMCNT=VALMCNT+1
+11 SET ^TMP("PXRMGEN",$JOB,VALMCNT,0)=TXT
+12 SET ^TMP("PXRMGEN",$JOB,"VALMCNT")=VALMCNT
+13 ;Dialog Text
+14 SET TSUB=0
SET TXT=" Dialog Text: "
+15 FOR
SET TSUB=$ORDER(^PXRMD(801.41,DIEN,25,TSUB))
if 'TSUB
QUIT
Begin DoDot:1
+16 SET DTXT=$GET(^PXRMD(801.41,DIEN,25,TSUB,0))
+17 SET VALMCNT=VALMCNT+1
+18 SET ^TMP("PXRMGEN",$JOB,VALMCNT,0)=TXT_DTXT
+19 SET ^TMP("PXRMGEN",$JOB,"VALMCNT")=VALMCNT
SET TXT=$JUSTIFY("",17)
End DoDot:1
+20 ;Additional prompts/forced values
+21 NEW ACNT,ADES,AIEN,ASUB,ATYP,DATA
+22 SET ASUB=0
SET ACNT=0
SET TXT=" Additional Prompts: "
+23 FOR
SET ASUB=$ORDER(^PXRMD(801.41,DIEN,10,ASUB))
if 'ASUB
QUIT
Begin DoDot:1
+24 ;Get prompt ien
+25 SET AIEN=$PIECE($GET(^PXRMD(801.41,DIEN,10,ASUB,0)),U,2)
if AIEN=""
QUIT
+26 ;Get description and type from dialog file
+27 SET DATA=$GET(^PXRMD(801.41,AIEN,0))
+28 SET ADES=$PIECE(DATA,U)
IF ADES=""
SET ADES=AIEN
+29 SET ATYP=""
IF $PIECE(DATA,U,4)="F"
SET ATYP=" (forced value)"
+30 SET VALMCNT=VALMCNT+1
SET ACNT=ACNT+1
+31 SET ^TMP("PXRMGEN",$JOB,VALMCNT,0)=TXT_ADES_ATYP
SET TXT=$JUSTIFY("",24)
+32 SET ^TMP("PXRMGEN",$JOB,"VALMCNT")=VALMCNT
End DoDot:1
+33 IF ACNT=0
Begin DoDot:1
+34 SET VALMCNT=VALMCNT+1
SET ACNT=ACNT+1
+35 SET ^TMP("PXRMGEN",$JOB,VALMCNT,0)=TXT_"*NONE*"
+36 SET ^TMP("PXRMGEN",$JOB,"VALMCNT")=VALMCNT
End DoDot:1
+37 QUIT
