- 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 Jan 18, 2025@03:29:54 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 ;