PXHFMGR ;SLC/PKR - List Manager routines for Health Factors. ;11/05/2018
;;1.0;PCE PATIENT CARE ENCOUNTER;**211**;Aug 12, 1996;Build 454
;
;=========================================
ADD ;Add a new entry.
S VALMBCK="R"
D CLEAR^VALM1
N CAT,CLASS,DIR,DIRUT,DOHS,ETYPE,L3C,LEN,NAME,TEXT,X,Y
NAME S DIR(0)="9999999.64,.01A"
S DIR("A")="Enter a new Health Factor Name: "
D ^DIR
I $D(DIRUT) S VALMBCK="R" Q
S NAME=X
I $D(^AUTTHF("B",NAME)) D G NAME
. S TEXT(1)=NAME_" already exists, choose a different name or use the EDIT action to edit that entry."
. S TEXT(2)=" "
. D EN^DDIOL(.TEXT)
;
S DIR(0)="9999999.64,.1A"
S DIR("A")="Enter the Entry Type: "
D ^DIR
I $D(DIRUT) S VALMBCK="R" Q
S ETYPE=Y(0)
;If the Entry Type is "C" check the name for the appended "[C]".
I ETYPE="CATEGORY" S NAME=$$CATNCHK(NAME)
I NAME="^" G NAME
S LEN=$L(NAME),L3C=$E(NAME,(LEN-2),LEN)
;If the name has the appended '[C]' make sure the Entry Type is
;category.
I (ETYPE="FACTOR"),(L3C="[C]") D G NAME
. S TEXT(1)="Factor names cannot end with '[C]', try again."
. S TEXT(2)=" "
. D EN^DDIOL(.TEXT)
. H 2
;
;Category is required for factors.
I ETYPE="FACTOR" D
. S DIR(0)="9999999.64,.03A"
. S DIR("A")="Enter the Category: "
. D ^DIR
. I '$D(DIRUT) S CAT=$P(Y,U,2)
I $D(DIRUT) S VALMBCK="R" Q
;
S DIR(0)="9999999.64,100A"
S DIR("A")="Enter the Class: "
D ^DIR
I $D(DIRUT) S VALMBCK="R" Q
S CLASS=Y(0)
;
S DIR(0)="9999999.64,.08A"
S DIR("A")="Enter Display on Health Summary: "
D ^DIR
I $D(DIRUT) S VALMBCK="R" Q
S DOHS=Y(0)
N FDA,IEN,MSG
S FDA(9999999.64,"+1,",.01)=NAME
I $G(CAT)'="" S FDA(9999999.64,"+1,",.03)=CAT
S FDA(9999999.64,"+1,",.08)=DOHS
S FDA(9999999.64,"+1,",.1)=ETYPE
S FDA(9999999.64,"+1,",100)=CLASS
D UPDATE^DIE("E","FDA","IEN","MSG")
I $D(MSG) D Q
. D EN^DDIOL("FileMan could not create the new entry, the FileMan error message is:")
. D AWRITE^PXUTIL("MSG")
. H 3
D SMANEDIT^PXHFSM(IEN(1),1)
Q
;
;=========================================
BLDLIST(NODE) ;Build the list of Health Factor file entries.
N IEN,DESC,NAME
K ^TMP(NODE,$J)
;Build the list in alphabetical order.
S NAME="",VALMCNT=0
F S NAME=$O(^AUTTHF("B",NAME)) Q:NAME="" D
. S IEN=$O(^AUTTHF("B",NAME,""))
. S VALMCNT=VALMCNT+1
. S ^TMP(NODE,$J,"SEL",VALMCNT)=IEN
. S ^TMP(NODE,$J,"IEN",IEN)=VALMCNT
. S DESC=$G(^AUTTHF(IEN,201,1,0))
. S ^TMP(NODE,$J,VALMCNT,0)=$$FORMAT(VALMCNT,NAME,DESC)
. S ^TMP(NODE,$J,"IDX",VALMCNT,VALMCNT)=""
. S ^TMP(NODE,$J,"LINES",VALMCNT)=VALMCNT_U_VALMCNT
S ^TMP(NODE,$J,"VALMCNT")=VALMCNT
S ^TMP(NODE,$J,"NHF")=VALMCNT
Q
;
;=========================================
CATNCHK(NAME) ;If the Entry Type is category make sure the name is
;appended with [C]. This entry point is used when adding a new entry.
N CNAME
S LEN=$L(NAME),L3C=$E(NAME,(LEN-2),LEN)
I L3C="[C]" Q NAME
D EN^DDIOL("Category names must end with '[C]', appending it for you.")
S CNAME=NAME_" [C]"
D EN^DDIOL(CNAME)
I $L(CNAME)>64 D
. D EN^DDIOL("exceeds 64 characters, it cannot be added, try again!")
. H 3
. S CNAME="^"
Q CNAME
;
;=========================================
CLOG(IEN) ;Display the change log.
D LMCLBROW^PXSINQ(9999999.64,"110*",IEN)
Q
;
;=========================================
CLOGS ;Display Change Log for a selected entry.
N IEN
;Get the entry
S IEN=+$$GETSEL("Display the change log for which health factor?")
S VALMBCK="R"
I IEN=0 S VALMBCK="R" Q
D CLOG(IEN)
S VALMBCK="R"
Q
;
;=========================================
COPY(IEN) ;Copy a selected entry to a new name.
D FULL^VALM1
D COPY^PXCOPY(9999999.64,IEN)
D BLDLIST^PXHFMGR("PXHFL")
S VALMBCK="R"
Q
;
;=========================================
COPYS ;Copy a selected entry.
N IEN
;Get the entry
S IEN=+$$GETSEL("Select health factor to copy")
I IEN=0 S VALMBCK="R" Q
D COPY(IEN)
Q
;
;=========================================
EDITS ;Edit a selected entry.
N CLASS,IEN
;Get the entry
S IEN=+$$GETSEL("Select the health factor to edit")
I IEN=0 S VALMBCK="R" Q
D SMANEDIT^PXHFSM(IEN,0)
Q
;
;=========================================
ENTRY ;Entry code
D INITMPG^PXHFMGR
D BLDLIST^PXHFMGR("PXHFL")
D XQORM
Q
;
;=========================================
EXIT ;Exit code
D INITMPG^PXHFMGR
D CLEAN^VALM10
D FULL^VALM1
S VALMBCK="Q"
Q
;
;=========================================
FORMAT(NUMBER,NAME,DESC) ;Format entry number, name,
;and first line of description for LM display.
N CAT,LNAME,TEXT,TDESC,TNAME
S LNAME=$L(NAME)
I LNAME<56 S TNAME=NAME
E D
. N CAT
. S CAT=$S($E(NAME,(LNAME-2),LNAME)="[C]":1,1:0)
. S TNAME=$S('CAT:$E(NAME,1,52)_"...",1:$E(NAME,1,49)_"...[C]")
S TEXT=$$RJ^XLFSTR(NUMBER,5," ")_" "_TNAME
S TDESC=$S(DESC="":"",$L(DESC)<17:DESC,1:$E(DESC,1,13)_"...")
I TDESC'="" S TEXT=TEXT_$$REPEAT^XLFSTR(" ",(63-$L(TEXT)))_TDESC
Q TEXT
;
;=========================================
GETSEL(TEXT) ;Get a single selection
N DIR,NHF,X,Y
S NHF=+$G(^TMP("PXHFL",$J,"NHF"))
I NHF=0 Q 0
S DIR(0)="N^1:"_NHF
S DIR("A")=TEXT
D ^DIR
Q +$G(^TMP("PXHFL",$J,"SEL",+Y))
;
;=========================================
HELP ;Display help.
N DDS,DIR0,DONE,IND,TEXT
;DBIA #5746 covers kill and set of DDS. DDS needs to be set or the
;Browser will kill some ScreenMan variables.
S DDS=1,DONE=0
F IND=1:1 Q:DONE D
. S TEXT(IND)=$P($T(HTEXT+IND),";",3,99)
. I TEXT(IND)="**End Text**" K TEXT(IND) S DONE=1 Q
D BROWSE^DDBR("TEXT","NR","Health Factor Management Help")
S VALMBCK="R"
Q
;
;=========================================
HDR ; Header code
S VALMHDR(1)="Health Factor File Entries."
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
Q
;
;=========================================
HTEXT ;Health Factor management help text.
;;Select one of the following actions:
;; ADD - add a new health factor.
;; EDIT - edit a health factor.
;; COPY - copy an existing health factor to a new health factor.
;; INQ - health factor inquiry.
;; CL - health factor change log display.
;;
;;You can select the action first and then the entry or choose the entry and then
;;the action.
;;
;;**End Text**
Q
;
;=========================================
INITMPG ;Initialize all the ^TMP globals.
K ^TMP("PXHFL",$J)
Q
;
;=========================================
INQ(IEN) ;Health Factor inquiry.
S VALMBCK="R"
D BHFINQ^PXHFINQ(IEN)
Q
;
;=========================================
INQS ;Display inquiry for selected entries.
S VALMBCK="R"
N IEN
;Get the entry
S IEN=+$$GETSEL("Display inquiry for which health factor?")
I IEN=0 S VALMBCK="R" Q
D INQ(IEN)
S VALMBCK="R"
Q
;
;=========================================
ISMAPPED(IEN) ;Return 1 if the health factor has mapped codes.
I +$P($G(^AUTTHF(IEN,210,0)),U,4)>0 Q 1
Q 0
;
;=========================================
PEXIT ; Protocol exit code
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
;Reset after page up/down etc
D XQORM
Q
;
;=========================================
START ;Main entry point for PX Health Factor Management
N VALMBCK,VALMSG,X
S X="IORESET"
D ENDR^%ZISS
D EN^VALM("PX HEALTH FACTOR MANAGEMENT")
W IORESET
D KILL^%ZISS
Q
;
;=========================================
XQORM ;Set range for selection.
N NHF
S NHF=^TMP("PXHFL",$J,"NHF")
S XQORM("#")=$O(^ORD(101,"B","PX HEALTH FACTOR SELECT ENTRY",0))_U_"1:"_NHF
S XQORM("A")="Select Action: "
Q
;
;=========================================
XSEL ;Entry action for protocol PX HEALTH FACTOR SELECT ENTRY.
N CLASS,EDITOK,IEN,SEL
S SEL=$P(XQORNOD(0),"=",2)
;Remove trailing ,
I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)
;Invalid selection
I SEL["," D Q
. W !,"Only one item number allowed." H 2
. S VALMBCK="R"
I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("SEL",SEL))) D Q
. W !,SEL_" is not a valid item number." H 2
. S VALMBCK="R"
;
;Get the IEN.
S IEN=^TMP("PXHFL",$J,"SEL",SEL)
S CLASS=$P(^AUTTHF(IEN,100),U,1)
;
;Full screen mode
D FULL^VALM1
;
;Action list.
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,OPTION,X,Y
S DIR(0)="SBM"_U
S EDITOK=$S(CLASS'="N":1,1:($G(PXNAT)=1)&($G(DUZ(0))="@"))
I EDITOK S DIR(0)=DIR(0)_"EDIT:Edit;"
S DIR(0)=DIR(0)_"COPY:Copy;"
S DIR(0)=DIR(0)_"INQ:Inquire;"
S DIR(0)=DIR(0)_"CL:Change Log;"
S DIR("A")="Select Action: "
S DIR("B")=$S(CLASS="N":"INQ",1:"EDIT")
S DIR("?")="Select from the actions displayed."
D ^DIR
I $D(DIROUT)!$D(DIRUT) S VALMBCK="R" Q
I $D(DTOUT)!$D(DUOUT) S VALMBCK="R" Q
S OPTION=Y
D CLEAR^VALM1
;
I OPTION="COPY" D COPY^PXHFMGR(IEN)
I OPTION="EDIT" D SMANEDIT^PXHFSM(IEN,0)
I OPTION="INQ" D BHFINQ^PXHFINQ(IEN)
I OPTION="CL" D CLOG^PXHFMGR(IEN)
S VALMBCK="R"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXHFMGR 8954 printed Apr 09, 2024@21:32:03 Page 2
PXHFMGR ;SLC/PKR - List Manager routines for Health Factors. ;11/05/2018
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**211**;Aug 12, 1996;Build 454
+2 ;
+3 ;=========================================
ADD ;Add a new entry.
+1 SET VALMBCK="R"
+2 DO CLEAR^VALM1
+3 NEW CAT,CLASS,DIR,DIRUT,DOHS,ETYPE,L3C,LEN,NAME,TEXT,X,Y
NAME SET DIR(0)="9999999.64,.01A"
+1 SET DIR("A")="Enter a new Health Factor Name: "
+2 DO ^DIR
+3 IF $DATA(DIRUT)
SET VALMBCK="R"
QUIT
+4 SET NAME=X
+5 IF $DATA(^AUTTHF("B",NAME))
Begin DoDot:1
+6 SET TEXT(1)=NAME_" already exists, choose a different name or use the EDIT action to edit that entry."
+7 SET TEXT(2)=" "
+8 DO EN^DDIOL(.TEXT)
End DoDot:1
GOTO NAME
+9 ;
+10 SET DIR(0)="9999999.64,.1A"
+11 SET DIR("A")="Enter the Entry Type: "
+12 DO ^DIR
+13 IF $DATA(DIRUT)
SET VALMBCK="R"
QUIT
+14 SET ETYPE=Y(0)
+15 ;If the Entry Type is "C" check the name for the appended "[C]".
+16 IF ETYPE="CATEGORY"
SET NAME=$$CATNCHK(NAME)
+17 IF NAME="^"
GOTO NAME
+18 SET LEN=$LENGTH(NAME)
SET L3C=$EXTRACT(NAME,(LEN-2),LEN)
+19 ;If the name has the appended '[C]' make sure the Entry Type is
+20 ;category.
+21 IF (ETYPE="FACTOR")
IF (L3C="[C]")
Begin DoDot:1
+22 SET TEXT(1)="Factor names cannot end with '[C]', try again."
+23 SET TEXT(2)=" "
+24 DO EN^DDIOL(.TEXT)
+25 HANG 2
End DoDot:1
GOTO NAME
+26 ;
+27 ;Category is required for factors.
+28 IF ETYPE="FACTOR"
Begin DoDot:1
+29 SET DIR(0)="9999999.64,.03A"
+30 SET DIR("A")="Enter the Category: "
+31 DO ^DIR
+32 IF '$DATA(DIRUT)
SET CAT=$PIECE(Y,U,2)
End DoDot:1
+33 IF $DATA(DIRUT)
SET VALMBCK="R"
QUIT
+34 ;
+35 SET DIR(0)="9999999.64,100A"
+36 SET DIR("A")="Enter the Class: "
+37 DO ^DIR
+38 IF $DATA(DIRUT)
SET VALMBCK="R"
QUIT
+39 SET CLASS=Y(0)
+40 ;
+41 SET DIR(0)="9999999.64,.08A"
+42 SET DIR("A")="Enter Display on Health Summary: "
+43 DO ^DIR
+44 IF $DATA(DIRUT)
SET VALMBCK="R"
QUIT
+45 SET DOHS=Y(0)
+46 NEW FDA,IEN,MSG
+47 SET FDA(9999999.64,"+1,",.01)=NAME
+48 IF $GET(CAT)'=""
SET FDA(9999999.64,"+1,",.03)=CAT
+49 SET FDA(9999999.64,"+1,",.08)=DOHS
+50 SET FDA(9999999.64,"+1,",.1)=ETYPE
+51 SET FDA(9999999.64,"+1,",100)=CLASS
+52 DO UPDATE^DIE("E","FDA","IEN","MSG")
+53 IF $DATA(MSG)
Begin DoDot:1
+54 DO EN^DDIOL("FileMan could not create the new entry, the FileMan error message is:")
+55 DO AWRITE^PXUTIL("MSG")
+56 HANG 3
End DoDot:1
QUIT
+57 DO SMANEDIT^PXHFSM(IEN(1),1)
+58 QUIT
+59 ;
+60 ;=========================================
BLDLIST(NODE) ;Build the list of Health Factor file entries.
+1 NEW IEN,DESC,NAME
+2 KILL ^TMP(NODE,$JOB)
+3 ;Build the list in alphabetical order.
+4 SET NAME=""
SET VALMCNT=0
+5 FOR
SET NAME=$ORDER(^AUTTHF("B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+6 SET IEN=$ORDER(^AUTTHF("B",NAME,""))
+7 SET VALMCNT=VALMCNT+1
+8 SET ^TMP(NODE,$JOB,"SEL",VALMCNT)=IEN
+9 SET ^TMP(NODE,$JOB,"IEN",IEN)=VALMCNT
+10 SET DESC=$GET(^AUTTHF(IEN,201,1,0))
+11 SET ^TMP(NODE,$JOB,VALMCNT,0)=$$FORMAT(VALMCNT,NAME,DESC)
+12 SET ^TMP(NODE,$JOB,"IDX",VALMCNT,VALMCNT)=""
+13 SET ^TMP(NODE,$JOB,"LINES",VALMCNT)=VALMCNT_U_VALMCNT
End DoDot:1
+14 SET ^TMP(NODE,$JOB,"VALMCNT")=VALMCNT
+15 SET ^TMP(NODE,$JOB,"NHF")=VALMCNT
+16 QUIT
+17 ;
+18 ;=========================================
CATNCHK(NAME) ;If the Entry Type is category make sure the name is
+1 ;appended with [C]. This entry point is used when adding a new entry.
+2 NEW CNAME
+3 SET LEN=$LENGTH(NAME)
SET L3C=$EXTRACT(NAME,(LEN-2),LEN)
+4 IF L3C="[C]"
QUIT NAME
+5 DO EN^DDIOL("Category names must end with '[C]', appending it for you.")
+6 SET CNAME=NAME_" [C]"
+7 DO EN^DDIOL(CNAME)
+8 IF $LENGTH(CNAME)>64
Begin DoDot:1
+9 DO EN^DDIOL("exceeds 64 characters, it cannot be added, try again!")
+10 HANG 3
+11 SET CNAME="^"
End DoDot:1
+12 QUIT CNAME
+13 ;
+14 ;=========================================
CLOG(IEN) ;Display the change log.
+1 DO LMCLBROW^PXSINQ(9999999.64,"110*",IEN)
+2 QUIT
+3 ;
+4 ;=========================================
CLOGS ;Display Change Log for a selected entry.
+1 NEW IEN
+2 ;Get the entry
+3 SET IEN=+$$GETSEL("Display the change log for which health factor?")
+4 SET VALMBCK="R"
+5 IF IEN=0
SET VALMBCK="R"
QUIT
+6 DO CLOG(IEN)
+7 SET VALMBCK="R"
+8 QUIT
+9 ;
+10 ;=========================================
COPY(IEN) ;Copy a selected entry to a new name.
+1 DO FULL^VALM1
+2 DO COPY^PXCOPY(9999999.64,IEN)
+3 DO BLDLIST^PXHFMGR("PXHFL")
+4 SET VALMBCK="R"
+5 QUIT
+6 ;
+7 ;=========================================
COPYS ;Copy a selected entry.
+1 NEW IEN
+2 ;Get the entry
+3 SET IEN=+$$GETSEL("Select health factor to copy")
+4 IF IEN=0
SET VALMBCK="R"
QUIT
+5 DO COPY(IEN)
+6 QUIT
+7 ;
+8 ;=========================================
EDITS ;Edit a selected entry.
+1 NEW CLASS,IEN
+2 ;Get the entry
+3 SET IEN=+$$GETSEL("Select the health factor to edit")
+4 IF IEN=0
SET VALMBCK="R"
QUIT
+5 DO SMANEDIT^PXHFSM(IEN,0)
+6 QUIT
+7 ;
+8 ;=========================================
ENTRY ;Entry code
+1 DO INITMPG^PXHFMGR
+2 DO BLDLIST^PXHFMGR("PXHFL")
+3 DO XQORM
+4 QUIT
+5 ;
+6 ;=========================================
EXIT ;Exit code
+1 DO INITMPG^PXHFMGR
+2 DO CLEAN^VALM10
+3 DO FULL^VALM1
+4 SET VALMBCK="Q"
+5 QUIT
+6 ;
+7 ;=========================================
FORMAT(NUMBER,NAME,DESC) ;Format entry number, name,
+1 ;and first line of description for LM display.
+2 NEW CAT,LNAME,TEXT,TDESC,TNAME
+3 SET LNAME=$LENGTH(NAME)
+4 IF LNAME<56
SET TNAME=NAME
+5 IF '$TEST
Begin DoDot:1
+6 NEW CAT
+7 SET CAT=$SELECT($EXTRACT(NAME,(LNAME-2),LNAME)="[C]":1,1:0)
+8 SET TNAME=$SELECT('CAT:$EXTRACT(NAME,1,52)_"...",1:$EXTRACT(NAME,1,49)_"...[C]")
End DoDot:1
+9 SET TEXT=$$RJ^XLFSTR(NUMBER,5," ")_" "_TNAME
+10 SET TDESC=$SELECT(DESC="":"",$LENGTH(DESC)<17:DESC,1:$EXTRACT(DESC,1,13)_"...")
+11 IF TDESC'=""
SET TEXT=TEXT_$$REPEAT^XLFSTR(" ",(63-$LENGTH(TEXT)))_TDESC
+12 QUIT TEXT
+13 ;
+14 ;=========================================
GETSEL(TEXT) ;Get a single selection
+1 NEW DIR,NHF,X,Y
+2 SET NHF=+$GET(^TMP("PXHFL",$JOB,"NHF"))
+3 IF NHF=0
QUIT 0
+4 SET DIR(0)="N^1:"_NHF
+5 SET DIR("A")=TEXT
+6 DO ^DIR
+7 QUIT +$GET(^TMP("PXHFL",$JOB,"SEL",+Y))
+8 ;
+9 ;=========================================
HELP ;Display help.
+1 NEW DDS,DIR0,DONE,IND,TEXT
+2 ;DBIA #5746 covers kill and set of DDS. DDS needs to be set or the
+3 ;Browser will kill some ScreenMan variables.
+4 SET DDS=1
SET DONE=0
+5 FOR IND=1:1
if DONE
QUIT
Begin DoDot:1
+6 SET TEXT(IND)=$PIECE($TEXT(HTEXT+IND),";",3,99)
+7 IF TEXT(IND)="**End Text**"
KILL TEXT(IND)
SET DONE=1
QUIT
End DoDot:1
+8 DO BROWSE^DDBR("TEXT","NR","Health Factor Management Help")
+9 SET VALMBCK="R"
+10 QUIT
+11 ;
+12 ;=========================================
HDR ; Header code
+1 SET VALMHDR(1)="Health Factor File Entries."
+2 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
+3 QUIT
+4 ;
+5 ;=========================================
HTEXT ;Health Factor management help text.
+1 ;;Select one of the following actions:
+2 ;; ADD - add a new health factor.
+3 ;; EDIT - edit a health factor.
+4 ;; COPY - copy an existing health factor to a new health factor.
+5 ;; INQ - health factor inquiry.
+6 ;; CL - health factor change log display.
+7 ;;
+8 ;;You can select the action first and then the entry or choose the entry and then
+9 ;;the action.
+10 ;;
+11 ;;**End Text**
+12 QUIT
+13 ;
+14 ;=========================================
INITMPG ;Initialize all the ^TMP globals.
+1 KILL ^TMP("PXHFL",$JOB)
+2 QUIT
+3 ;
+4 ;=========================================
INQ(IEN) ;Health Factor inquiry.
+1 SET VALMBCK="R"
+2 DO BHFINQ^PXHFINQ(IEN)
+3 QUIT
+4 ;
+5 ;=========================================
INQS ;Display inquiry for selected entries.
+1 SET VALMBCK="R"
+2 NEW IEN
+3 ;Get the entry
+4 SET IEN=+$$GETSEL("Display inquiry for which health factor?")
+5 IF IEN=0
SET VALMBCK="R"
QUIT
+6 DO INQ(IEN)
+7 SET VALMBCK="R"
+8 QUIT
+9 ;
+10 ;=========================================
ISMAPPED(IEN) ;Return 1 if the health factor has mapped codes.
+1 IF +$PIECE($GET(^AUTTHF(IEN,210,0)),U,4)>0
QUIT 1
+2 QUIT 0
+3 ;
+4 ;=========================================
PEXIT ; Protocol exit code
+1 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
+2 ;Reset after page up/down etc
+3 DO XQORM
+4 QUIT
+5 ;
+6 ;=========================================
START ;Main entry point for PX Health Factor Management
+1 NEW VALMBCK,VALMSG,X
+2 SET X="IORESET"
+3 DO ENDR^%ZISS
+4 DO EN^VALM("PX HEALTH FACTOR MANAGEMENT")
+5 WRITE IORESET
+6 DO KILL^%ZISS
+7 QUIT
+8 ;
+9 ;=========================================
XQORM ;Set range for selection.
+1 NEW NHF
+2 SET NHF=^TMP("PXHFL",$JOB,"NHF")
+3 SET XQORM("#")=$ORDER(^ORD(101,"B","PX HEALTH FACTOR SELECT ENTRY",0))_U_"1:"_NHF
+4 SET XQORM("A")="Select Action: "
+5 QUIT
+6 ;
+7 ;=========================================
XSEL ;Entry action for protocol PX HEALTH FACTOR SELECT ENTRY.
+1 NEW CLASS,EDITOK,IEN,SEL
+2 SET SEL=$PIECE(XQORNOD(0),"=",2)
+3 ;Remove trailing ,
+4 IF $EXTRACT(SEL,$LENGTH(SEL))=","
SET SEL=$EXTRACT(SEL,1,$LENGTH(SEL)-1)
+5 ;Invalid selection
+6 IF SEL[","
Begin DoDot:1
+7 WRITE !,"Only one item number allowed."
HANG 2
+8 SET VALMBCK="R"
End DoDot:1
QUIT
+9 IF ('SEL)!(SEL>VALMCNT)!('$DATA(@VALMAR@("SEL",SEL)))
Begin DoDot:1
+10 WRITE !,SEL_" is not a valid item number."
HANG 2
+11 SET VALMBCK="R"
End DoDot:1
QUIT
+12 ;
+13 ;Get the IEN.
+14 SET IEN=^TMP("PXHFL",$JOB,"SEL",SEL)
+15 SET CLASS=$PIECE(^AUTTHF(IEN,100),U,1)
+16 ;
+17 ;Full screen mode
+18 DO FULL^VALM1
+19 ;
+20 ;Action list.
+21 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,OPTION,X,Y
+22 SET DIR(0)="SBM"_U
+23 SET EDITOK=$SELECT(CLASS'="N":1,1:($GET(PXNAT)=1)&($GET(DUZ(0))="@"))
+24 IF EDITOK
SET DIR(0)=DIR(0)_"EDIT:Edit;"
+25 SET DIR(0)=DIR(0)_"COPY:Copy;"
+26 SET DIR(0)=DIR(0)_"INQ:Inquire;"
+27 SET DIR(0)=DIR(0)_"CL:Change Log;"
+28 SET DIR("A")="Select Action: "
+29 SET DIR("B")=$SELECT(CLASS="N":"INQ",1:"EDIT")
+30 SET DIR("?")="Select from the actions displayed."
+31 DO ^DIR
+32 IF $DATA(DIROUT)!$DATA(DIRUT)
SET VALMBCK="R"
QUIT
+33 IF $DATA(DTOUT)!$DATA(DUOUT)
SET VALMBCK="R"
QUIT
+34 SET OPTION=Y
+35 DO CLEAR^VALM1
+36 ;
+37 IF OPTION="COPY"
DO COPY^PXHFMGR(IEN)
+38 IF OPTION="EDIT"
DO SMANEDIT^PXHFSM(IEN,0)
+39 IF OPTION="INQ"
DO BHFINQ^PXHFINQ(IEN)
+40 IF OPTION="CL"
DO CLOG^PXHFMGR(IEN)
+41 SET VALMBCK="R"
+42 QUIT
+43 ;
