Routine: PXRMSHF

PXRMSHF ; SLC/PJH - Edit/Inquire Health Factor Resolutions ;03/17/2000

 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

START N DIC,PXRMGTYP,PXRMHD,PXRMSHF,Y

SELECT ;General selection

 S PXRMHD="Health Factor Resolutions",PXRMGTYP="SHFR",PXRMSHF=""

 D START^PXRMSEL(PXRMHD,PXRMGTYP,"PXRMSHF")

 ;Should return a value

 I PXRMSHF D  G SELECT

 .S PXRMHD="HEALTH FACTOR NAME:"

 .;Listman option

 .D START^PXRMGEN(PXRMHD,PXRMGTYP,PXRMSHF)

END Q

 ;List all HF resolutions (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.95,"

 S BY=".01"

 S FR=""

 S TO=""

 S DHD="W ?0 D HED^PXRMSHF"

 D DISP

 ;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.95,"

 S DIC(0)="AEMQ"

 D SET

 D DISP

 ;Display Header (see DHD variable)

 ;--------------

HED N TEMP,TEXTLEN,TEXTHED,TEXTUND

 S TEXTHED="HEALTH FACTOR RESOLUTION LIST"

 S TEXTUND=$TR($J("",IOM)," ","-")

 S TEMP=NOW_"  Page "_DC

 S TEXTLEN=$L(TEMP)

 W TEXTHED

 W ?(IOM-TEXTLEN),TEMP

 W !,TEXTUND,!!

 ;DISPLAY (Display from FLDS array)

 ;-------

DISP S L=0,FLDS="[PXRM HEALTH FACTOR RESOLUTIONS]"

 D EN1^DIP

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^PXRMSHF"

 ;Build display for selected HF - Called from PXRMGEN

 ;---------------------------------------------------

SHFR(PXRMSHFR) ;

 N DATA,DARRAY,SUB

 S VALMCNT=0 K ^TMP("PXRMGENS",$J),^TMP("PXRMGEN",$J)

 ;Format headings to include Health Factor name

 S HEADER=PXRMHD_" "_$P(^AUTTHF(PXRMSHF,0),U)_" - HF("_PXRMSHF_")"

 ;Build HF Resolutions Display

 D BUILD(.DARRAY,PXRMSHFR)

 ;Build Health Factor Resolutions Inquiry array

 ;---------------------------------------------

BUILD(ARRAY,D0) ;

 N DATA,LCT,RDES,RIEN,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.95,IEN,1,SUB)) Q:'SUB  D

 .;Get ien for resolution status

 .S RIEN=$P($G(^PXRMD(801.95,IEN,1,SUB,0)),U) Q:RIEN=""

 .;Get description

 .S RDES=$P($G(^PXRMD(801.9,RIEN,0)),U) I RDES="" S RDES=RIEN

 .;Save Resolution in alpha order

 .S ^TMP("PXRMGENS",$J,RDES)=SUB

 ;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 VALMCNT=VALMCNT+1,LCT=LCT+1

 .S ^TMP("PXRMGEN",$J,VALMCNT,0)=" "_RDES

 .S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT

 K ^TMP("PXRMGENS",$J)

 ;Create headings

 D CHGCAP^VALM("HEADER1","Resolution Status")

 D CHGCAP^VALM("HEADER2","")

 D CHGCAP^VALM("HEADER3","")

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMSHF   2975     printed  Mar 13, 2025@20:53:47                                                                                                                                                                                                     Page 2

PXRMSHF   ; SLC/PJH - Edit/Inquire Health Factor Resolutions ;03/17/2000

 +1       ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

 +2       ;

START      NEW DIC,PXRMGTYP,PXRMHD,PXRMSHF,Y

SELECT    ;General selection

 +1        SET PXRMHD="Health Factor Resolutions"

           SET PXRMGTYP="SHFR"

           SET PXRMSHF=""

 +2        DO START^PXRMSEL(PXRMHD,PXRMGTYP,"PXRMSHF")

 +3       ;Should return a value

 +4        IF PXRMSHF

               Begin DoDot:1

 +5                SET PXRMHD="HEALTH FACTOR NAME:"

 +6       ;Listman option

 +7                DO START^PXRMGEN(PXRMHD,PXRMGTYP,PXRMSHF)

               End DoDot:1

               GOTO SELECT

 +8       ;

END        QUIT

 +1       ;

 +2       ;List all HF resolutions (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.95,"

 +4        SET BY=".01"

 +5        SET FR=""

 +6        SET TO=""

 +7        SET DHD="W ?0 D HED^PXRMSHF"

 +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.95,"

 +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="HEALTH FACTOR RESOLUTION 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 HEALTH FACTOR RESOLUTIONS]"

 +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^PXRMSHF"

 +9       ;

 +10       QUIT

 +11      ;

 +12      ;Build display for selected HF - Called from PXRMGEN

 +13      ;---------------------------------------------------

SHFR(PXRMSHFR) ;

 +1        NEW DATA,DARRAY,SUB

 +2        SET VALMCNT=0

           KILL ^TMP("PXRMGENS",$JOB),^TMP("PXRMGEN",$JOB)

 +3       ;

 +4       ;Format headings to include Health Factor name

 +5        SET HEADER=PXRMHD_" "_$PIECE(^AUTTHF(PXRMSHF,0),U)_" - HF("_PXRMSHF_")"

 +6       ;

 +7       ;Build HF Resolutions Display

 +8        DO BUILD(.DARRAY,PXRMSHFR)

 +9        QUIT

 +10      ;

 +11      ;Build Health Factor Resolutions Inquiry array

 +12      ;---------------------------------------------

BUILD(ARRAY,D0) ;

 +1        NEW DATA,LCT,RDES,RIEN,SUB

 +2        SET VALMCNT=0

           KILL ^TMP("PXRMGENS",$JOB),^TMP("PXRMGEN",$JOB)

 +3       ;

 +4        SET SUB=0

 +5       ;Loop through all the resolution statuses

 +6        FOR

               SET SUB=$ORDER(^PXRMD(801.95,IEN,1,SUB))

               if 'SUB

                   QUIT

               Begin DoDot:1

 +7       ;Get ien for resolution status

 +8                SET RIEN=$PIECE($GET(^PXRMD(801.95,IEN,1,SUB,0)),U)

                   if RIEN=""

                       QUIT

 +9       ;Get description

 +10               SET RDES=$PIECE($GET(^PXRMD(801.9,RIEN,0)),U)

                   IF RDES=""

                       SET RDES=RIEN

 +11      ;Save Resolution in alpha order

 +12               SET ^TMP("PXRMGENS",$JOB,RDES)=SUB

               End DoDot:1

 +13      ;

 +14      ;Put the list into the array List Manager is using.

 +15       SET RDES=""

           SET LCT=0

 +16       SET VALMCNT=0

 +17       FOR

               SET RDES=$ORDER(^TMP("PXRMGENS",$JOB,RDES))

               if RDES=""

                   QUIT

               Begin DoDot:1

 +18               SET DATA=$GET(^TMP("PXRMGENS",$JOB,RDES))

 +19               SET VALMCNT=VALMCNT+1

                   SET LCT=LCT+1

 +20               SET ^TMP("PXRMGEN",$JOB,VALMCNT,0)=" "_RDES

 +21               SET ^TMP("PXRMGEN",$JOB,"VALMCNT")=VALMCNT

               End DoDot:1

 +22       KILL ^TMP("PXRMGENS",$JOB)

 +23      ;Create headings

 +24       DO CHGCAP^VALM("HEADER1","Resolution Status")

 +25       DO CHGCAP^VALM("HEADER2","")

 +26       DO CHGCAP^VALM("HEADER3","")

 +27       QUIT

PXRMSHF.m