Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXHFINQ

PXHFINQ.m

Go to the documentation of this file. 
  1. PXHFINQ ;SLC/PKR - Health Factor Inquire. ;03/21/2022
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**211,217**;Aug 12, 1996;Build 134
  1.  ;
  1.  ;==========================================
  1. BHFINQ(IEN) ;Display an Health Factor inquiry, defaults to the Browser.
  1.  N BOP,DIR0,OUTPUT,TITLE,TYPE
  1.  I '$D(^AUTTHF(IEN)) Q
  1.  S TITLE="Health Factor Inquiry"
  1.  D HFINQ(IEN,.OUTPUT)
  1.  S BOP=$$BORP^PXUTIL("B")
  1.  I BOP="" Q
  1.  I BOP="B" D BROWSE^DDBR("OUTPUT","NR",TITLE)
  1.  I BOP="P" D GPRINT^PXUTIL("OUTPUT")
  1.  Q
  1.  ;
  1.  ;==========================================
  1. HFINQ(IEN,OUTPUT) ;Health Factor inquiry, return the formatted text in OUTPUT.
  1.  ;Use 80 column output.
  1.  N CODE,CODELIST,CODESYS,IENSTR,IND,INDXDT,LEN,MAPDT
  1.  N NL,NSP,RM,TEMP,TEXT,WPARRAY
  1.  S RM=80
  1.  S TEMP=^AUTTHF(IEN,0)
  1.  S IENSTR="No. "_IEN
  1.  S OUTPUT(1)=$$REPEAT^XLFSTR("-",RM)
  1.  S TEXT=$P(TEMP,U,1)
  1.  S NSP=RM-$L(TEXT)-1
  1.  S OUTPUT(2)=TEXT_$$RJ^XLFSTR(IENSTR,NSP," ")
  1.  S OUTPUT(3)=$$REPEAT^XLFSTR("-",RM)
  1.  S OUTPUT(4)="Print Name: "_$$GET1^DIQ(9999999.64,IEN,200)
  1.  S OUTPUT(5)="Class: "_$$GET1^DIQ(9999999.64,IEN,100)
  1.  S OUTPUT(6)="Sponsor: "_$$GET1^DIQ(9999999.64,IEN,101)
  1.  S OUTPUT(7)="Entry Type: "_$$GET1^DIQ(9999999.64,IEN,.1)
  1.  S OUTPUT(8)="Category: "_$$GET1^DIQ(9999999.64,IEN,.03)
  1.  S OUTPUT(9)="Display on Health Summary: "_$$GET1^DIQ(9999999.64,IEN,.08)
  1.  S OUTPUT(10)="Inactive Flag: "_$$GET1^DIQ(9999999.64,IEN,.11)
  1.  S OUTPUT(11)="Short Name: "_$$GET1^DIQ(9999999.64,IEN,.04)
  1.  S TEXT="Lower Age: "_$$GET1^DIQ(9999999.64,IEN,.06)
  1.  S TEXT=TEXT_"  Upper Age: "_$$GET1^DIQ(9999999.64,IEN,.07)
  1.  S OUTPUT(12)=TEXT
  1.  S OUTPUT(13)="Use Only With Sex: "_$$GET1^DIQ(9999999.64,IEN,.05)
  1.  S OUTPUT(14)=""
  1.  S OUTPUT(15)="Description:"
  1.  S NL=15
  1.  S TEMP=$$GET1^DIQ(9999999.64,IEN,201,"","WPARRAY")
  1.  I TEMP="" S NL=NL+1,OUTPUT(NL)=""
  1.  I TEMP="WPARRAY" D
  1.  . S IND=0
  1.  . F  S IND=$O(WPARRAY(IND)) Q:IND=""  S NL=NL+1,OUTPUT(NL)=WPARRAY(IND)
  1.  . K WPARRAY
  1.  ;
  1.  ;Mapped Codes.
  1.  S IND=0
  1.  F  S IND=+$O(^AUTTHF(IEN,210,IND)) Q:IND=0  D
  1.  . S TEMP=^AUTTHF(IEN,210,IND,0)
  1.  . S CODESYS=$P(TEMP,U,1),CODE=$P(TEMP,U,2)
  1.  . S MAPDT=$P(TEMP,U,3),INDXDT=$P(TEMP,U,4)
  1.  . I CODE'="" S CODELIST(CODESYS,CODE)=MAPDT_U_INDXDT
  1.  D MCDISP^PXMCODES(.CODELIST,.NL,.OUTPUT)
  1.  ;
  1.  ;
  1.  ;Deleted code mappings.
  1.  I $P($G(^AUTTHF(IEN,230,0)),U,4)>0 D
  1.  . S NL=NL+1,OUTPUT(NL)=""
  1.  . S NL=NL+1,OUTPUT(NL)=""
  1.  . S NL=NL+1,OUTPUT(NL)="Deleted Code Mappings"
  1.  . S IND=0
  1.  . F  S IND=+$O(^AUTTHF(IEN,230,IND)) Q:IND=0  D
  1.  .. S TEMP=^AUTTHF(IEN,230,IND,0)
  1.  .. S NL=NL+1,OUTPUT(NL)=""
  1.  .. S NL=NL+1,OUTPUT(NL)=" Coding System: "_$P(TEMP,U,1)_"  Code: "_$P(TEMP,U,2)
  1.  .. S NL=NL+1,OUTPUT(NL)=" Date deleted: "_$$FMTE^XLFDT($P(TEMP,U,3),"5Z")
  1.  .. S OUTPUT(NL)=OUTPUT(NL)_"  Deleted by: "_$$GET1^DIQ(200,$P(TEMP,U,4),.01)
  1.  .. S NL=NL+1,OUTPUT(NL)=" Mapped Source Entry removal completion date: "_$$FMTE^XLFDT($P(TEMP,U,5),"5Z")
  1.  . S NL=NL+1,OUTPUT(NL)=""
  1.  ;
  1.  S NL=NL+1,OUTPUT(NL)=""
  1.  S NL=NL+1,OUTPUT(NL)="                             Value Range"
  1.  S TEMP=$G(^AUTTHF(IEN,220))
  1.  I TEMP="" S NL=NL+1,OUTPUT(NL)="Not defined"
  1.  E  D
  1.  . S NL=NL+1,OUTPUT(NL)=" Minimum Value                Maximum Value           UCUM Code"
  1.  . S NL=NL+1,OUTPUT(NL)=$S($E(TEMP,1)="-":"",1:" ")_$P(TEMP,U,1)
  1.  . S LEN=$L(OUTPUT(NL)),NSP=30-LEN
  1.  . S OUTPUT(NL)=OUTPUT(NL)_$$REPEAT^XLFSTR(" ",NSP)_$P(TEMP,U,2)
  1.  . N UCUMDATA,UCUMIEN
  1.  . S UCUMIEN=+$P(TEMP,U,4)
  1.  . I UCUMIEN>0 D
  1.  ..;ICR #6225
  1.  .. D UCUMDATA^LEXMUCUM(UCUMIEN,.UCUMDATA)
  1.  .. S LEN=$L(OUTPUT(NL)),NSP=54-LEN
  1.  .. S OUTPUT(NL)=OUTPUT(NL)_$$REPEAT^XLFSTR(" ",NSP)_UCUMDATA(UCUMIEN,"UCUM CODE")
  1.  .. S NL=NL+1,OUTPUT(NL)=""
  1.  .. S NL=NL+1,OUTPUT(NL)="UCUM Description: "_UCUMDATA(UCUMIEN,"DESCRIPTION")
  1.  .. S NL=NL+1,OUTPUT(NL)="Prompt Caption: "_$P(TEMP,U,5)
  1.  .. S NL=NL+1,OUTPUT(NL)="UCUM Display: "_$$EXTERNAL^DILFD(9999999.64,225,"",$P(TEMP,U,6))
  1.  S NL=NL+1,OUTPUT(NL)=""
  1.  Q
  1.  ;