PXRMFPAR ; SLC/PJH - PXRM Finding Type Parameter Edit/Inquiry; 01/21/2000
;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
;
;Labels called from list 'PXRM FINDING PARAMETER LIST'
;
START(HEADER,IEN) ;
N PXRMREAD,PXRMSRC,PXRMVARM
N VALM,VAKMAR,VALMBCK,VALMBG,VALMCNT,VALMHDR,VALMSG,X,XMZ
S X="IORESET"
D ENDR^%ZISS
D EN^VALM("PXRM FINDING PARAMETER LIST")
W IORESET
D KILL^%ZISS
Q
;
EXIT ;Exit code
D CLEAN^VALM10
D FULL^VALM1
S VALMBCK="Q"
K ^TMP("PXRMFP",$J)
Q
;
HDR ; Header code
S VALMHDR(1)=HEADER
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
Q
;
HELP ;Help code
N ORU,ORUPRMT,XQORM,PXRMTAG S PXRMTAG="G"_PXRMGTYP
D EN^VALM("PXRM DIALOG MAIN HELP")
Q
;
INIT ;Init
S VALMCNT=0
D BUILD
D XQORM
Q
;
;Load details
BUILD N ACNT,ADES,AIEN,ASUB,ATYP,DATA,LCT,PTXT,RDES,RDIS,RIEN,STRING,STXT,SUB
S VALMCNT=0 K ^TMP("PXRMFPS",$J),^TMP("PXRMFP",$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("PXRMFPS",$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("PXRMFPS",$J,RDES)) Q:RDES="" D
.S DATA=$G(^TMP("PXRMFPS",$J,RDES))
.S SUB=$P(DATA,U),PTXT=$P(DATA,U,2),STXT=$P(DATA,U,3),RDIS=$P(DATA,U,4)
.S LCT=LCT+1,VALMCNT=VALMCNT+1
.S STRING=LCT_" "_RDES_$J("",(27-$L(RDES)))_PTXT_"/"
.S ^TMP("PXRMFP",$J,VALMCNT,0)=STRING_$J("",71-$L(STRING))_RDIS
.S VALMCNT=VALMCNT+1
.S ^TMP("PXRMFP",$J,VALMCNT,0)=$J("",29)_"/"_STXT
.S ^TMP("PXRMFP",$J,"VALMCNT")=VALMCNT
.S ^TMP("PXRMFP",$J,"IDX",LCT,SUB)=""
.;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("PXRMFP",$J,VALMCNT,0)=$J("",29)_ACNT_"] "_ADES_ATYP
.;Final linefeed
.S VALMCNT=VALMCNT+1
.S ^TMP("PXRMFP",$J,VALMCNT,0)=$J("",79)
.S ^TMP("PXRMFP",$J,"VALMCNT")=VALMCNT
K ^TMP("PXRMFPS",$J)
;Create headings
D CHGCAP^VALM("HEADER1","Resolution Status")
D CHGCAP^VALM("HEADER2","Prefix//Suffix & Prompts/Values/Actions")
D CHGCAP^VALM("HEADER3","Status")
Q
;
PEXIT ;PXRM GENERAL MENU protocol exit code
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
D XQORM
Q
;
SEL ;PXRM SELECT RESOLUTION validation
N ERR,IEN,SEL
S VALMBCK="",SEL=+$P(XQORNOD(0),"=",2)
;Invalid selection
I '$D(@VALMAR@("IDX",SEL)) D Q
.W $C(7),!,SEL_" is not a valid item number." H 2
.S VALMBCK="R"
;Valid selection
S IEN=$O(@VALMAR@("IDX",SEL,""))
I IEN D
.S VALMBCK="Q",PXRMFSUB=IEN
Q
;
XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM SELECT RESOLUTION",0))_U_"1:"_VALMCNT
S XQORM("A")="Select number of Resolution Status to Edit: "
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMFPAR 3523 printed Dec 13, 2024@01:45:32 Page 2
PXRMFPAR ; SLC/PJH - PXRM Finding Type Parameter Edit/Inquiry; 01/21/2000
+1 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
+2 ;
+3 ;Labels called from list 'PXRM FINDING PARAMETER LIST'
+4 ;
START(HEADER,IEN) ;
+1 NEW PXRMREAD,PXRMSRC,PXRMVARM
+2 NEW VALM,VAKMAR,VALMBCK,VALMBG,VALMCNT,VALMHDR,VALMSG,X,XMZ
+3 SET X="IORESET"
+4 DO ENDR^%ZISS
+5 DO EN^VALM("PXRM FINDING PARAMETER LIST")
+6 WRITE IORESET
+7 DO KILL^%ZISS
+8 QUIT
+9 ;
EXIT ;Exit code
+1 DO CLEAN^VALM10
+2 DO FULL^VALM1
+3 SET VALMBCK="Q"
+4 KILL ^TMP("PXRMFP",$JOB)
+5 QUIT
+6 ;
HDR ; Header code
+1 SET VALMHDR(1)=HEADER
+2 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
+3 QUIT
+4 ;
HELP ;Help code
+1 NEW ORU,ORUPRMT,XQORM,PXRMTAG
SET PXRMTAG="G"_PXRMGTYP
+2 DO EN^VALM("PXRM DIALOG MAIN HELP")
+3 QUIT
+4 ;
INIT ;Init
+1 SET VALMCNT=0
+2 DO BUILD
+3 DO XQORM
+4 QUIT
+5 ;
+6 ;Load details
BUILD NEW ACNT,ADES,AIEN,ASUB,ATYP,DATA,LCT,PTXT,RDES,RDIS,RIEN,STRING,STXT,SUB
+1 SET VALMCNT=0
KILL ^TMP("PXRMFPS",$JOB),^TMP("PXRMFP",$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("PXRMFPS",$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("PXRMFPS",$JOB,RDES))
if RDES=""
QUIT
Begin DoDot:1
+22 SET DATA=$GET(^TMP("PXRMFPS",$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 LCT=LCT+1
SET VALMCNT=VALMCNT+1
+25 SET STRING=LCT_" "_RDES_$JUSTIFY("",(27-$LENGTH(RDES)))_PTXT_"/"
+26 SET ^TMP("PXRMFP",$JOB,VALMCNT,0)=STRING_$JUSTIFY("",71-$LENGTH(STRING))_RDIS
+27 SET VALMCNT=VALMCNT+1
+28 SET ^TMP("PXRMFP",$JOB,VALMCNT,0)=$JUSTIFY("",29)_"/"_STXT
+29 SET ^TMP("PXRMFP",$JOB,"VALMCNT")=VALMCNT
+30 SET ^TMP("PXRMFP",$JOB,"IDX",LCT,SUB)=""
+31 ;Then get the additional prompts/forced values
+32 SET ASUB=0
SET ACNT=0
+33 FOR
SET ASUB=$ORDER(^PXRMD(801.45,IEN,1,SUB,5,ASUB))
if 'ASUB
QUIT
Begin DoDot:2
+34 ;Get prompt ien
+35 SET AIEN=$PIECE($GET(^PXRMD(801.45,IEN,1,SUB,5,ASUB,0)),U)
if AIEN=""
QUIT
+36 ;Get description and type from dialog file
+37 SET DATA=$GET(^PXRMD(801.41,AIEN,0))
+38 SET ADES=$PIECE(DATA,U)
IF ADES=""
SET ADES=AIEN
+39 SET ATYP=""
IF $PIECE(DATA,U,4)="F"
SET ATYP=" (forced value)"
+40 SET VALMCNT=VALMCNT+1
SET ACNT=ACNT+1
+41 SET ^TMP("PXRMFP",$JOB,VALMCNT,0)=$JUSTIFY("",29)_ACNT_"] "_ADES_ATYP
End DoDot:2
+42 ;Final linefeed
+43 SET VALMCNT=VALMCNT+1
+44 SET ^TMP("PXRMFP",$JOB,VALMCNT,0)=$JUSTIFY("",79)
+45 SET ^TMP("PXRMFP",$JOB,"VALMCNT")=VALMCNT
End DoDot:1
+46 KILL ^TMP("PXRMFPS",$JOB)
+47 ;Create headings
+48 DO CHGCAP^VALM("HEADER1","Resolution Status")
+49 DO CHGCAP^VALM("HEADER2","Prefix//Suffix & Prompts/Values/Actions")
+50 DO CHGCAP^VALM("HEADER3","Status")
+51 QUIT
+52 ;
PEXIT ;PXRM GENERAL MENU protocol exit code
+1 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
+2 DO XQORM
+3 QUIT
+4 ;
SEL ;PXRM SELECT RESOLUTION validation
+1 NEW ERR,IEN,SEL
+2 SET VALMBCK=""
SET SEL=+$PIECE(XQORNOD(0),"=",2)
+3 ;Invalid selection
+4 IF '$DATA(@VALMAR@("IDX",SEL))
Begin DoDot:1
+5 WRITE $CHAR(7),!,SEL_" is not a valid item number."
HANG 2
+6 SET VALMBCK="R"
End DoDot:1
QUIT
+7 ;Valid selection
+8 SET IEN=$ORDER(@VALMAR@("IDX",SEL,""))
+9 IF IEN
Begin DoDot:1
+10 SET VALMBCK="Q"
SET PXRMFSUB=IEN
End DoDot:1
+11 QUIT
+12 ;
XQORM SET XQORM("#")=$ORDER(^ORD(101,"B","PXRM SELECT RESOLUTION",0))_U_"1:"_VALMCNT
+1 SET XQORM("A")="Select number of Resolution Status to Edit: "
+2 QUIT
