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
Q
;
;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
Q
;
;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,!!
Q
;
;DISPLAY (Display from FLDS array)
;-------
DISP S L=0,FLDS="[PXRM HEALTH FACTOR RESOLUTIONS]"
D EN1^DIP
Q
;
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"
;
Q
;
;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)
Q
;
;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","")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMSHF 2975 printed Apr 09, 2024@20:53:15 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
