PXRMFPAR.m

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 ---PXRMFPAR   3523     printed  Feb 18, 2025@23:11:54                                                                                                                                                                                                    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