PXHFINQ ;SLC/PKR - Health Factor Inquire. ;03/21/2022
;;1.0;PCE PATIENT CARE ENCOUNTER;**211,217**;Aug 12, 1996;Build 134
;
;==========================================
BHFINQ(IEN) ;Display an Health Factor inquiry, defaults to the Browser.
N BOP,DIR0,OUTPUT,TITLE,TYPE
I '$D(^AUTTHF(IEN)) Q
S TITLE="Health Factor Inquiry"
D HFINQ(IEN,.OUTPUT)
S BOP=$$BORP^PXUTIL("B")
I BOP="" Q
I BOP="B" D BROWSE^DDBR("OUTPUT","NR",TITLE)
I BOP="P" D GPRINT^PXUTIL("OUTPUT")
Q
;
;==========================================
HFINQ(IEN,OUTPUT) ;Health Factor inquiry, return the formatted text in OUTPUT.
;Use 80 column output.
N CODE,CODELIST,CODESYS,IENSTR,IND,INDXDT,LEN,MAPDT
N NL,NSP,RM,TEMP,TEXT,WPARRAY
S RM=80
S TEMP=^AUTTHF(IEN,0)
S IENSTR="No. "_IEN
S OUTPUT(1)=$$REPEAT^XLFSTR("-",RM)
S TEXT=$P(TEMP,U,1)
S NSP=RM-$L(TEXT)-1
S OUTPUT(2)=TEXT_$$RJ^XLFSTR(IENSTR,NSP," ")
S OUTPUT(3)=$$REPEAT^XLFSTR("-",RM)
S OUTPUT(4)="Print Name: "_$$GET1^DIQ(9999999.64,IEN,200)
S OUTPUT(5)="Class: "_$$GET1^DIQ(9999999.64,IEN,100)
S OUTPUT(6)="Sponsor: "_$$GET1^DIQ(9999999.64,IEN,101)
S OUTPUT(7)="Entry Type: "_$$GET1^DIQ(9999999.64,IEN,.1)
S OUTPUT(8)="Category: "_$$GET1^DIQ(9999999.64,IEN,.03)
S OUTPUT(9)="Display on Health Summary: "_$$GET1^DIQ(9999999.64,IEN,.08)
S OUTPUT(10)="Inactive Flag: "_$$GET1^DIQ(9999999.64,IEN,.11)
S OUTPUT(11)="Short Name: "_$$GET1^DIQ(9999999.64,IEN,.04)
S TEXT="Lower Age: "_$$GET1^DIQ(9999999.64,IEN,.06)
S TEXT=TEXT_" Upper Age: "_$$GET1^DIQ(9999999.64,IEN,.07)
S OUTPUT(12)=TEXT
S OUTPUT(13)="Use Only With Sex: "_$$GET1^DIQ(9999999.64,IEN,.05)
S OUTPUT(14)=""
S OUTPUT(15)="Description:"
S NL=15
S TEMP=$$GET1^DIQ(9999999.64,IEN,201,"","WPARRAY")
I TEMP="" S NL=NL+1,OUTPUT(NL)=""
I TEMP="WPARRAY" D
. S IND=0
. F S IND=$O(WPARRAY(IND)) Q:IND="" S NL=NL+1,OUTPUT(NL)=WPARRAY(IND)
. K WPARRAY
;
;Mapped Codes.
S IND=0
F S IND=+$O(^AUTTHF(IEN,210,IND)) Q:IND=0 D
. S TEMP=^AUTTHF(IEN,210,IND,0)
. S CODESYS=$P(TEMP,U,1),CODE=$P(TEMP,U,2)
. S MAPDT=$P(TEMP,U,3),INDXDT=$P(TEMP,U,4)
. I CODE'="" S CODELIST(CODESYS,CODE)=MAPDT_U_INDXDT
D MCDISP^PXMCODES(.CODELIST,.NL,.OUTPUT)
;
;
;Deleted code mappings.
I $P($G(^AUTTHF(IEN,230,0)),U,4)>0 D
. S NL=NL+1,OUTPUT(NL)=""
. S NL=NL+1,OUTPUT(NL)=""
. S NL=NL+1,OUTPUT(NL)="Deleted Code Mappings"
. S IND=0
. F S IND=+$O(^AUTTHF(IEN,230,IND)) Q:IND=0 D
.. S TEMP=^AUTTHF(IEN,230,IND,0)
.. S NL=NL+1,OUTPUT(NL)=""
.. S NL=NL+1,OUTPUT(NL)=" Coding System: "_$P(TEMP,U,1)_" Code: "_$P(TEMP,U,2)
.. S NL=NL+1,OUTPUT(NL)=" Date deleted: "_$$FMTE^XLFDT($P(TEMP,U,3),"5Z")
.. S OUTPUT(NL)=OUTPUT(NL)_" Deleted by: "_$$GET1^DIQ(200,$P(TEMP,U,4),.01)
.. S NL=NL+1,OUTPUT(NL)=" Mapped Source Entry removal completion date: "_$$FMTE^XLFDT($P(TEMP,U,5),"5Z")
. S NL=NL+1,OUTPUT(NL)=""
;
S NL=NL+1,OUTPUT(NL)=""
S NL=NL+1,OUTPUT(NL)=" Value Range"
S TEMP=$G(^AUTTHF(IEN,220))
I TEMP="" S NL=NL+1,OUTPUT(NL)="Not defined"
E D
. S NL=NL+1,OUTPUT(NL)=" Minimum Value Maximum Value UCUM Code"
. S NL=NL+1,OUTPUT(NL)=$S($E(TEMP,1)="-":"",1:" ")_$P(TEMP,U,1)
. S LEN=$L(OUTPUT(NL)),NSP=30-LEN
. S OUTPUT(NL)=OUTPUT(NL)_$$REPEAT^XLFSTR(" ",NSP)_$P(TEMP,U,2)
. N UCUMDATA,UCUMIEN
. S UCUMIEN=+$P(TEMP,U,4)
. I UCUMIEN>0 D
..;ICR #6225
.. D UCUMDATA^LEXMUCUM(UCUMIEN,.UCUMDATA)
.. S LEN=$L(OUTPUT(NL)),NSP=54-LEN
.. S OUTPUT(NL)=OUTPUT(NL)_$$REPEAT^XLFSTR(" ",NSP)_UCUMDATA(UCUMIEN,"UCUM CODE")
.. S NL=NL+1,OUTPUT(NL)=""
.. S NL=NL+1,OUTPUT(NL)="UCUM Description: "_UCUMDATA(UCUMIEN,"DESCRIPTION")
.. S NL=NL+1,OUTPUT(NL)="Prompt Caption: "_$P(TEMP,U,5)
.. S NL=NL+1,OUTPUT(NL)="UCUM Display: "_$$EXTERNAL^DILFD(9999999.64,225,"",$P(TEMP,U,6))
S NL=NL+1,OUTPUT(NL)=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXHFINQ 3870 printed Nov 22, 2024@17:38:52 Page 2
PXHFINQ ;SLC/PKR - Health Factor Inquire. ;03/21/2022
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**211,217**;Aug 12, 1996;Build 134
+2 ;
+3 ;==========================================
BHFINQ(IEN) ;Display an Health Factor inquiry, defaults to the Browser.
+1 NEW BOP,DIR0,OUTPUT,TITLE,TYPE
+2 IF '$DATA(^AUTTHF(IEN))
QUIT
+3 SET TITLE="Health Factor Inquiry"
+4 DO HFINQ(IEN,.OUTPUT)
+5 SET BOP=$$BORP^PXUTIL("B")
+6 IF BOP=""
QUIT
+7 IF BOP="B"
DO BROWSE^DDBR("OUTPUT","NR",TITLE)
+8 IF BOP="P"
DO GPRINT^PXUTIL("OUTPUT")
+9 QUIT
+10 ;
+11 ;==========================================
HFINQ(IEN,OUTPUT) ;Health Factor inquiry, return the formatted text in OUTPUT.
+1 ;Use 80 column output.
+2 NEW CODE,CODELIST,CODESYS,IENSTR,IND,INDXDT,LEN,MAPDT
+3 NEW NL,NSP,RM,TEMP,TEXT,WPARRAY
+4 SET RM=80
+5 SET TEMP=^AUTTHF(IEN,0)
+6 SET IENSTR="No. "_IEN
+7 SET OUTPUT(1)=$$REPEAT^XLFSTR("-",RM)
+8 SET TEXT=$PIECE(TEMP,U,1)
+9 SET NSP=RM-$LENGTH(TEXT)-1
+10 SET OUTPUT(2)=TEXT_$$RJ^XLFSTR(IENSTR,NSP," ")
+11 SET OUTPUT(3)=$$REPEAT^XLFSTR("-",RM)
+12 SET OUTPUT(4)="Print Name: "_$$GET1^DIQ(9999999.64,IEN,200)
+13 SET OUTPUT(5)="Class: "_$$GET1^DIQ(9999999.64,IEN,100)
+14 SET OUTPUT(6)="Sponsor: "_$$GET1^DIQ(9999999.64,IEN,101)
+15 SET OUTPUT(7)="Entry Type: "_$$GET1^DIQ(9999999.64,IEN,.1)
+16 SET OUTPUT(8)="Category: "_$$GET1^DIQ(9999999.64,IEN,.03)
+17 SET OUTPUT(9)="Display on Health Summary: "_$$GET1^DIQ(9999999.64,IEN,.08)
+18 SET OUTPUT(10)="Inactive Flag: "_$$GET1^DIQ(9999999.64,IEN,.11)
+19 SET OUTPUT(11)="Short Name: "_$$GET1^DIQ(9999999.64,IEN,.04)
+20 SET TEXT="Lower Age: "_$$GET1^DIQ(9999999.64,IEN,.06)
+21 SET TEXT=TEXT_" Upper Age: "_$$GET1^DIQ(9999999.64,IEN,.07)
+22 SET OUTPUT(12)=TEXT
+23 SET OUTPUT(13)="Use Only With Sex: "_$$GET1^DIQ(9999999.64,IEN,.05)
+24 SET OUTPUT(14)=""
+25 SET OUTPUT(15)="Description:"
+26 SET NL=15
+27 SET TEMP=$$GET1^DIQ(9999999.64,IEN,201,"","WPARRAY")
+28 IF TEMP=""
SET NL=NL+1
SET OUTPUT(NL)=""
+29 IF TEMP="WPARRAY"
Begin DoDot:1
+30 SET IND=0
+31 FOR
SET IND=$ORDER(WPARRAY(IND))
if IND=""
QUIT
SET NL=NL+1
SET OUTPUT(NL)=WPARRAY(IND)
+32 KILL WPARRAY
End DoDot:1
+33 ;
+34 ;Mapped Codes.
+35 SET IND=0
+36 FOR
SET IND=+$ORDER(^AUTTHF(IEN,210,IND))
if IND=0
QUIT
Begin DoDot:1
+37 SET TEMP=^AUTTHF(IEN,210,IND,0)
+38 SET CODESYS=$PIECE(TEMP,U,1)
SET CODE=$PIECE(TEMP,U,2)
+39 SET MAPDT=$PIECE(TEMP,U,3)
SET INDXDT=$PIECE(TEMP,U,4)
+40 IF CODE'=""
SET CODELIST(CODESYS,CODE)=MAPDT_U_INDXDT
End DoDot:1
+41 DO MCDISP^PXMCODES(.CODELIST,.NL,.OUTPUT)
+42 ;
+43 ;
+44 ;Deleted code mappings.
+45 IF $PIECE($GET(^AUTTHF(IEN,230,0)),U,4)>0
Begin DoDot:1
+46 SET NL=NL+1
SET OUTPUT(NL)=""
+47 SET NL=NL+1
SET OUTPUT(NL)=""
+48 SET NL=NL+1
SET OUTPUT(NL)="Deleted Code Mappings"
+49 SET IND=0
+50 FOR
SET IND=+$ORDER(^AUTTHF(IEN,230,IND))
if IND=0
QUIT
Begin DoDot:2
+51 SET TEMP=^AUTTHF(IEN,230,IND,0)
+52 SET NL=NL+1
SET OUTPUT(NL)=""
+53 SET NL=NL+1
SET OUTPUT(NL)=" Coding System: "_$PIECE(TEMP,U,1)_" Code: "_$PIECE(TEMP,U,2)
+54 SET NL=NL+1
SET OUTPUT(NL)=" Date deleted: "_$$FMTE^XLFDT($PIECE(TEMP,U,3),"5Z")
+55 SET OUTPUT(NL)=OUTPUT(NL)_" Deleted by: "_$$GET1^DIQ(200,$PIECE(TEMP,U,4),.01)
+56 SET NL=NL+1
SET OUTPUT(NL)=" Mapped Source Entry removal completion date: "_$$FMTE^XLFDT($PIECE(TEMP,U,5),"5Z")
End DoDot:2
+57 SET NL=NL+1
SET OUTPUT(NL)=""
End DoDot:1
+58 ;
+59 SET NL=NL+1
SET OUTPUT(NL)=""
+60 SET NL=NL+1
SET OUTPUT(NL)=" Value Range"
+61 SET TEMP=$GET(^AUTTHF(IEN,220))
+62 IF TEMP=""
SET NL=NL+1
SET OUTPUT(NL)="Not defined"
+63 IF '$TEST
Begin DoDot:1
+64 SET NL=NL+1
SET OUTPUT(NL)=" Minimum Value Maximum Value UCUM Code"
+65 SET NL=NL+1
SET OUTPUT(NL)=$SELECT($EXTRACT(TEMP,1)="-":"",1:" ")_$PIECE(TEMP,U,1)
+66 SET LEN=$LENGTH(OUTPUT(NL))
SET NSP=30-LEN
+67 SET OUTPUT(NL)=OUTPUT(NL)_$$REPEAT^XLFSTR(" ",NSP)_$PIECE(TEMP,U,2)
+68 NEW UCUMDATA,UCUMIEN
+69 SET UCUMIEN=+$PIECE(TEMP,U,4)
+70 IF UCUMIEN>0
Begin DoDot:2
+71 ;ICR #6225
+72 DO UCUMDATA^LEXMUCUM(UCUMIEN,.UCUMDATA)
+73 SET LEN=$LENGTH(OUTPUT(NL))
SET NSP=54-LEN
+74 SET OUTPUT(NL)=OUTPUT(NL)_$$REPEAT^XLFSTR(" ",NSP)_UCUMDATA(UCUMIEN,"UCUM CODE")
+75 SET NL=NL+1
SET OUTPUT(NL)=""
+76 SET NL=NL+1
SET OUTPUT(NL)="UCUM Description: "_UCUMDATA(UCUMIEN,"DESCRIPTION")
+77 SET NL=NL+1
SET OUTPUT(NL)="Prompt Caption: "_$PIECE(TEMP,U,5)
+78 SET NL=NL+1
SET OUTPUT(NL)="UCUM Display: "_$$EXTERNAL^DILFD(9999999.64,225,"",$PIECE(TEMP,U,6))
End DoDot:2
End DoDot:1
+79 SET NL=NL+1
SET OUTPUT(NL)=""
+80 QUIT
+81 ;
