- 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 Jan 18, 2025@02:46:41 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