PXRMFIND ; SLC/PJH - Edit/Inquire finding type parameters ;08/21/2014
;;2.0;CLINICAL REMINDERS;**47**;Feb 04, 2005;Build 291
;
START N DIC,FTYP,PXRMGTYP,PXRMHD,PXRMFIEN,PXRMFSUB,Y
;Get lists of finding types for display
;N DEF,DEF1,DEF2 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)
N DEF2,IND,TEMP
S IND=0
F S IND=+$O(^DD(801.41,15,"V",IND)) Q:IND=0 D
. S TEMP=^DD(801.41,15,"V",IND,0)
. S DEF2($P(TEMP,U,4))=$P(TEMP,U,2),DEF2($P(TEMP,U,4),1)=$P(TEMP,U)
S DEF2("OI")="ORDERABLE ITEM",DEF2("OI",1)=101.43
SELECT ;General selection
S PXRMHD="Finding Type Parameters",PXRMFIEN="",PXRMGTYP="FPAR"
D START^PXRMSEL(PXRMHD,PXRMGTYP,"PXRMFIEN")
;Should return a value
I PXRMFIEN D G SELECT
.;Format headings to include category name
.S PXRMHD="FINDING TYPE PARAMETER NAME: "
.S FTYP=$P(^PXRMD(801.45,PXRMFIEN,0),U)
.I FTYP="POV" S PXRMHD=PXRMHD_FTYP_" - Diagnosis (Taxonomy)"
.I FTYP="CPT" S PXRMHD=PXRMHD_FTYP_" - Procedure (Taxonomy)"
.I $D(DEF2(FTYP)) S PXRMHD=PXRMHD_FTYP_" - "_DEF2(FTYP)
.;Install option allows extended edit/add/delete
.I $G(PXRMINST)=1 D START^PXRMGEN(PXRMHD,PXRMGTYP,PXRMFIEN) Q
.;Otherwise limited edit options
.F D Q:'PXRMFSUB
..S PXRMFSUB="" D START^PXRMFPAR(PXRMHD,PXRMFIEN)
..I PXRMFSUB D
...N X
...S X="IORESET"
...D ENDR^%ZISS
...D EDIT^PXRMGEDT(PXRMGTYP,PXRMFSUB,1)
END Q
;
;Called from PXRM SELECTION LIST
;-------------------------------
FPAR N ACNT,ADES,AIEN,ASUB,ATYP,DATA,LCT,PTXT,RDES,RDIS,RIEN,STRING,STXT,SUB
S VALMCNT=0 K ^TMP("PXRMGENS",$J),^TMP("PXRMGEN",$J)
S SUB=0
;Loop through all the resolution statuses
F S SUB=$O(^PXRMD(801.45,IEN,1,SUB)) Q:'SUB D
.;Get ien for resolution status
.S RIEN=$P($G(^PXRMD(801.45,IEN,1,SUB,0)),U) Q:RIEN=""
.;Get description
.S RDES=$P($G(^PXRMD(801.9,RIEN,0)),U) I RDES="" S RDES=RIEN
.;Get Prefix and suffix text
.S PTXT=$E($G(^PXRMD(801.45,IEN,1,SUB,3)),1,40)
.S STXT=$E($G(^PXRMD(801.45,IEN,1,SUB,4)),1,40)
.;Get disabled flag
.S RDIS=$P($G(^PXRMD(801.45,IEN,1,SUB,0)),U,2)
.S RDIS=$S(RDIS=1:"Disabled",1:"Enabled")
.;Save Resolution in alpha order
.S ^TMP("PXRMGENS",$J,RDES)=SUB_U_PTXT_U_STXT_U_RDIS
;
;Put the list into the array List Manager is using.
S RDES="",LCT=0
S VALMCNT=0
F S RDES=$O(^TMP("PXRMGENS",$J,RDES)) Q:RDES="" D
.S DATA=$G(^TMP("PXRMGENS",$J,RDES))
.S SUB=$P(DATA,U),PTXT=$P(DATA,U,2),STXT=$P(DATA,U,3),RDIS=$P(DATA,U,4)
.S VALMCNT=VALMCNT+1,LCT=LCT+1
.S STRING=LCT_" "_RDES_$J("",(27-$L(RDES)))_PTXT_"/"
.S ^TMP("PXRMGEN",$J,VALMCNT,0)=STRING_$J("",71-$L(STRING))_RDIS
.S VALMCNT=VALMCNT+1
.S ^TMP("PXRMGEN",$J,VALMCNT,0)=$J("",29)_"/"_STXT
.S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT
.;Then get the additional prompts/forced values
.S ASUB=0,ACNT=0
.F S ASUB=$O(^PXRMD(801.45,IEN,1,SUB,5,ASUB)) Q:'ASUB D
..;Get prompt ien
..S AIEN=$P($G(^PXRMD(801.45,IEN,1,SUB,5,ASUB,0)),U) 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)=$J("",29)_ACNT_"] "_ADES_ATYP
.;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","Resolution Status")
D CHGCAP^VALM("HEADER2","Prefix//Suffix & Prompts/Values/Actions")
D CHGCAP^VALM("HEADER3","Status")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMFIND 3543 printed Dec 13, 2024@01:45:27 Page 2
PXRMFIND ; SLC/PJH - Edit/Inquire finding type parameters ;08/21/2014
+1 ;;2.0;CLINICAL REMINDERS;**47**;Feb 04, 2005;Build 291
+2 ;
START NEW DIC,FTYP,PXRMGTYP,PXRMHD,PXRMFIEN,PXRMFSUB,Y
+1 ;Get lists of finding types for display
+2 ;N DEF,DEF1,DEF2 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)
+3 NEW DEF2,IND,TEMP
+4 SET IND=0
+5 FOR
SET IND=+$ORDER(^DD(801.41,15,"V",IND))
if IND=0
QUIT
Begin DoDot:1
+6 SET TEMP=^DD(801.41,15,"V",IND,0)
+7 SET DEF2($PIECE(TEMP,U,4))=$PIECE(TEMP,U,2)
SET DEF2($PIECE(TEMP,U,4),1)=$PIECE(TEMP,U)
End DoDot:1
+8 SET DEF2("OI")="ORDERABLE ITEM"
SET DEF2("OI",1)=101.43
SELECT ;General selection
+1 SET PXRMHD="Finding Type Parameters"
SET PXRMFIEN=""
SET PXRMGTYP="FPAR"
+2 DO START^PXRMSEL(PXRMHD,PXRMGTYP,"PXRMFIEN")
+3 ;Should return a value
+4 IF PXRMFIEN
Begin DoDot:1
+5 ;Format headings to include category name
+6 SET PXRMHD="FINDING TYPE PARAMETER NAME: "
+7 SET FTYP=$PIECE(^PXRMD(801.45,PXRMFIEN,0),U)
+8 IF FTYP="POV"
SET PXRMHD=PXRMHD_FTYP_" - Diagnosis (Taxonomy)"
+9 IF FTYP="CPT"
SET PXRMHD=PXRMHD_FTYP_" - Procedure (Taxonomy)"
+10 IF $DATA(DEF2(FTYP))
SET PXRMHD=PXRMHD_FTYP_" - "_DEF2(FTYP)
+11 ;Install option allows extended edit/add/delete
+12 IF $GET(PXRMINST)=1
DO START^PXRMGEN(PXRMHD,PXRMGTYP,PXRMFIEN)
QUIT
+13 ;Otherwise limited edit options
+14 FOR
Begin DoDot:2
+15 SET PXRMFSUB=""
DO START^PXRMFPAR(PXRMHD,PXRMFIEN)
+16 IF PXRMFSUB
Begin DoDot:3
+17 NEW X
+18 SET X="IORESET"
+19 DO ENDR^%ZISS
+20 DO EDIT^PXRMGEDT(PXRMGTYP,PXRMFSUB,1)
End DoDot:3
End DoDot:2
if 'PXRMFSUB
QUIT
End DoDot:1
GOTO SELECT
END QUIT
+1 ;
+2 ;Called from PXRM SELECTION LIST
+3 ;-------------------------------
FPAR NEW ACNT,ADES,AIEN,ASUB,ATYP,DATA,LCT,PTXT,RDES,RDIS,RIEN,STRING,STXT,SUB
+1 SET VALMCNT=0
KILL ^TMP("PXRMGENS",$JOB),^TMP("PXRMGEN",$JOB)
+2 SET SUB=0
+3 ;Loop through all the resolution statuses
+4 FOR
SET SUB=$ORDER(^PXRMD(801.45,IEN,1,SUB))
if 'SUB
QUIT
Begin DoDot:1
+5 ;Get ien for resolution status
+6 SET RIEN=$PIECE($GET(^PXRMD(801.45,IEN,1,SUB,0)),U)
if RIEN=""
QUIT
+7 ;Get description
+8 SET RDES=$PIECE($GET(^PXRMD(801.9,RIEN,0)),U)
IF RDES=""
SET RDES=RIEN
+9 ;Get Prefix and suffix text
+10 SET PTXT=$EXTRACT($GET(^PXRMD(801.45,IEN,1,SUB,3)),1,40)
+11 SET STXT=$EXTRACT($GET(^PXRMD(801.45,IEN,1,SUB,4)),1,40)
+12 ;Get disabled flag
+13 SET RDIS=$PIECE($GET(^PXRMD(801.45,IEN,1,SUB,0)),U,2)
+14 SET RDIS=$SELECT(RDIS=1:"Disabled",1:"Enabled")
+15 ;Save Resolution in alpha order
+16 SET ^TMP("PXRMGENS",$JOB,RDES)=SUB_U_PTXT_U_STXT_U_RDIS
End DoDot:1
+17 ;
+18 ;Put the list into the array List Manager is using.
+19 SET RDES=""
SET LCT=0
+20 SET VALMCNT=0
+21 FOR
SET RDES=$ORDER(^TMP("PXRMGENS",$JOB,RDES))
if RDES=""
QUIT
Begin DoDot:1
+22 SET DATA=$GET(^TMP("PXRMGENS",$JOB,RDES))
+23 SET SUB=$PIECE(DATA,U)
SET PTXT=$PIECE(DATA,U,2)
SET STXT=$PIECE(DATA,U,3)
SET RDIS=$PIECE(DATA,U,4)
+24 SET VALMCNT=VALMCNT+1
SET LCT=LCT+1
+25 SET STRING=LCT_" "_RDES_$JUSTIFY("",(27-$LENGTH(RDES)))_PTXT_"/"
+26 SET ^TMP("PXRMGEN",$JOB,VALMCNT,0)=STRING_$JUSTIFY("",71-$LENGTH(STRING))_RDIS
+27 SET VALMCNT=VALMCNT+1
+28 SET ^TMP("PXRMGEN",$JOB,VALMCNT,0)=$JUSTIFY("",29)_"/"_STXT
+29 SET ^TMP("PXRMGEN",$JOB,"VALMCNT")=VALMCNT
+30 ;Then get the additional prompts/forced values
+31 SET ASUB=0
SET ACNT=0
+32 FOR
SET ASUB=$ORDER(^PXRMD(801.45,IEN,1,SUB,5,ASUB))
if 'ASUB
QUIT
Begin DoDot:2
+33 ;Get prompt ien
+34 SET AIEN=$PIECE($GET(^PXRMD(801.45,IEN,1,SUB,5,ASUB,0)),U)
if AIEN=""
QUIT
+35 ;Get description and type from dialog file
+36 SET DATA=$GET(^PXRMD(801.41,AIEN,0))
+37 SET ADES=$PIECE(DATA,U)
IF ADES=""
SET ADES=AIEN
+38 SET ATYP=""
IF $PIECE(DATA,U,4)="F"
SET ATYP=" (forced value)"
+39 SET VALMCNT=VALMCNT+1
SET ACNT=ACNT+1
+40 SET ^TMP("PXRMGEN",$JOB,VALMCNT,0)=$JUSTIFY("",29)_ACNT_"] "_ADES_ATYP
End DoDot:2
+41 ;Final linefeed
+42 SET VALMCNT=VALMCNT+1
+43 SET ^TMP("PXRMGEN",$JOB,VALMCNT,0)=$JUSTIFY("",79)
+44 SET ^TMP("PXRMGEN",$JOB,"VALMCNT")=VALMCNT
End DoDot:1
+45 KILL ^TMP("PXRMGENS",$JOB)
+46 ;Create headings
+47 DO CHGCAP^VALM("HEADER1","Resolution Status")
+48 DO CHGCAP^VALM("HEADER2","Prefix//Suffix & Prompts/Values/Actions")
+49 DO CHGCAP^VALM("HEADER3","Status")
+50 QUIT
