| 1 | PXRMSHF ; SLC/PJH - Edit/Inquire Health Factor Resolutions ;03/17/2000
|
|---|
| 2 | ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
|
|---|
| 3 | ;
|
|---|
| 4 | START N DIC,PXRMGTYP,PXRMHD,PXRMSHF,Y
|
|---|
| 5 | SELECT ;General selection
|
|---|
| 6 | S PXRMHD="Health Factor Resolutions",PXRMGTYP="SHFR",PXRMSHF=""
|
|---|
| 7 | D START^PXRMSEL(PXRMHD,PXRMGTYP,"PXRMSHF")
|
|---|
| 8 | ;Should return a value
|
|---|
| 9 | I PXRMSHF D G SELECT
|
|---|
| 10 | .S PXRMHD="HEALTH FACTOR NAME:"
|
|---|
| 11 | .;Listman option
|
|---|
| 12 | .D START^PXRMGEN(PXRMHD,PXRMGTYP,PXRMSHF)
|
|---|
| 13 | ;
|
|---|
| 14 | END Q
|
|---|
| 15 | ;
|
|---|
| 16 | ;List all HF resolutions (for protocol PXRM SELECTION LIST)
|
|---|
| 17 | ;-----------------------
|
|---|
| 18 | ALL N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,NOW,TO,Y
|
|---|
| 19 | S Y=1
|
|---|
| 20 | D SET
|
|---|
| 21 | S DIC="^PXRMD(801.95,"
|
|---|
| 22 | S BY=".01"
|
|---|
| 23 | S FR=""
|
|---|
| 24 | S TO=""
|
|---|
| 25 | S DHD="W ?0 D HED^PXRMSHF"
|
|---|
| 26 | D DISP
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | ;Inquire/Print Option (for protocol PXRM GENERAL INQUIRE/PRINT)
|
|---|
| 30 | ;--------------------
|
|---|
| 31 | INQ(Y) N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,NOW,TO
|
|---|
| 32 | S DIC="^PXRMD(801.95,"
|
|---|
| 33 | S DIC(0)="AEMQ"
|
|---|
| 34 | D SET
|
|---|
| 35 | D DISP
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | ;Display Header (see DHD variable)
|
|---|
| 39 | ;--------------
|
|---|
| 40 | HED N TEMP,TEXTLEN,TEXTHED,TEXTUND
|
|---|
| 41 | S TEXTHED="HEALTH FACTOR RESOLUTION LIST"
|
|---|
| 42 | S TEXTUND=$TR($J("",IOM)," ","-")
|
|---|
| 43 | S TEMP=NOW_" Page "_DC
|
|---|
| 44 | S TEXTLEN=$L(TEMP)
|
|---|
| 45 | W TEXTHED
|
|---|
| 46 | W ?(IOM-TEXTLEN),TEMP
|
|---|
| 47 | W !,TEXTUND,!!
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | ;DISPLAY (Display from FLDS array)
|
|---|
| 51 | ;-------
|
|---|
| 52 | DISP S L=0,FLDS="[PXRM HEALTH FACTOR RESOLUTIONS]"
|
|---|
| 53 | D EN1^DIP
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
| 56 | SET ;Setup all the variables
|
|---|
| 57 | ; Set Date for Header
|
|---|
| 58 | S NOW=$$NOW^XLFDT
|
|---|
| 59 | S NOW=$$FMTE^XLFDT(NOW,"1P")
|
|---|
| 60 | ;
|
|---|
| 61 | ;These variables need to be setup every time because DIP kills them.
|
|---|
| 62 | S BY="NUMBER"
|
|---|
| 63 | S (FR,TO)=+$P(Y,U,1)
|
|---|
| 64 | S DHD="W ?0 D HED^PXRMSHF"
|
|---|
| 65 | ;
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
| 68 | ;Build display for selected HF - Called from PXRMGEN
|
|---|
| 69 | ;---------------------------------------------------
|
|---|
| 70 | SHFR(PXRMSHFR) ;
|
|---|
| 71 | N DATA,DARRAY,SUB
|
|---|
| 72 | S VALMCNT=0 K ^TMP("PXRMGENS",$J),^TMP("PXRMGEN",$J)
|
|---|
| 73 | ;
|
|---|
| 74 | ;Format headings to include Health Factor name
|
|---|
| 75 | S HEADER=PXRMHD_" "_$P(^AUTTHF(PXRMSHF,0),U)_" - HF("_PXRMSHF_")"
|
|---|
| 76 | ;
|
|---|
| 77 | ;Build HF Resolutions Display
|
|---|
| 78 | D BUILD(.DARRAY,PXRMSHFR)
|
|---|
| 79 | Q
|
|---|
| 80 | ;
|
|---|
| 81 | ;Build Health Factor Resolutions Inquiry array
|
|---|
| 82 | ;---------------------------------------------
|
|---|
| 83 | BUILD(ARRAY,D0) ;
|
|---|
| 84 | N DATA,LCT,RDES,RIEN,SUB
|
|---|
| 85 | S VALMCNT=0 K ^TMP("PXRMGENS",$J),^TMP("PXRMGEN",$J)
|
|---|
| 86 | ;
|
|---|
| 87 | S SUB=0
|
|---|
| 88 | ;Loop through all the resolution statuses
|
|---|
| 89 | F S SUB=$O(^PXRMD(801.95,IEN,1,SUB)) Q:'SUB D
|
|---|
| 90 | .;Get ien for resolution status
|
|---|
| 91 | .S RIEN=$P($G(^PXRMD(801.95,IEN,1,SUB,0)),U) Q:RIEN=""
|
|---|
| 92 | .;Get description
|
|---|
| 93 | .S RDES=$P($G(^PXRMD(801.9,RIEN,0)),U) I RDES="" S RDES=RIEN
|
|---|
| 94 | .;Save Resolution in alpha order
|
|---|
| 95 | .S ^TMP("PXRMGENS",$J,RDES)=SUB
|
|---|
| 96 | ;
|
|---|
| 97 | ;Put the list into the array List Manager is using.
|
|---|
| 98 | S RDES="",LCT=0
|
|---|
| 99 | S VALMCNT=0
|
|---|
| 100 | F S RDES=$O(^TMP("PXRMGENS",$J,RDES)) Q:RDES="" D
|
|---|
| 101 | .S DATA=$G(^TMP("PXRMGENS",$J,RDES))
|
|---|
| 102 | .S VALMCNT=VALMCNT+1,LCT=LCT+1
|
|---|
| 103 | .S ^TMP("PXRMGEN",$J,VALMCNT,0)=" "_RDES
|
|---|
| 104 | .S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT
|
|---|
| 105 | K ^TMP("PXRMGENS",$J)
|
|---|
| 106 | ;Create headings
|
|---|
| 107 | D CHGCAP^VALM("HEADER1","Resolution Status")
|
|---|
| 108 | D CHGCAP^VALM("HEADER2","")
|
|---|
| 109 | D CHGCAP^VALM("HEADER3","")
|
|---|
| 110 | Q
|
|---|
