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

FHWORA.m

Go to the documentation of this file. 
  1. FHWORA ; HISC/GJC - OE/RR Procedure Call (Assessments) ;11/6/97  15:35
  1.  ;;5.5;DIETETICS;**8**;Jan 28, 2005;Build 28
  1. FHWORADT(DFN) ; Pass back the Assessment Dates for a particular patient.
  1.  ;----------------------------------------------------------------------
  1.  ; Input : DFN -> the ien of the patient
  1.  ; Output: -1^error text -> no assessments passed back with reason being
  1.  ;                          error text
  1.  ;         1 -> Assessments for our patient have been found.  Data will
  1.  ;              stored in:
  1.  ;              ^TMP($J,"FHADT",DFN,inv internal dt/time)=ext dt/time
  1.  ;----------------------------------------------------------------------
  1.  Q:'$L(DFN) "-1^patient data missing"
  1.  S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q "-1^patient data missing"
  1.  Q:'$D(^FHPT(FHDFN,0)) "-1^invalid patient (not in Dietetics Patient file)"
  1.  Q:'+$O(^FHPT(FHDFN,"N",0)) "-1^No assessments on file"
  1.  ;K ^TMP($J,"FHADT",DFN) N FH115A,I S I=6929298 ;7/1/2007
  1.  ;K ^TMP($J,"FHADT",DFN) N FH115A,I S I=6929398 ;6/1/2007
  1.  K ^TMP($J,"FHADT",DFN) N FH115A,I S I=6928998 ;10/1/2007
  1.  F  S I=$O(^FHPT(FHDFN,"N",I)) Q:I'>0  D
  1.  . S FH115A=$G(^FHPT(FHDFN,"N",I,0))
  1.  . S ^TMP($J,"FHADT",DFN,I)=$$FMTE^XLFDT($P(FH115A,"^"),1)
  1.  . Q
  1.  Q $S($D(^TMP($J,"FHADT",DFN)):1,1:"-1^No assessments prior to 10/1/2007 on file")
  1.  ;
  1. FHWORASM(DFN,FHADTX) ; Store Assessment data so it can be displayed
  1.  ;----------------------------------------------------------------------
  1.  ; Input : DFN    -> ien of the patient
  1.  ;         FHADTX -> Assessment Date (external format)
  1.  ; Output: -1^error text, error text will be failure reason
  1.  ;         1, no error data to be stored in:
  1.  ;         ^TMP($J,"FHASM",DFN,seq #)="lines of text"
  1.  ;----------------------------------------------------------------------
  1.  Q:'$L(DFN) "-1^patient data missing"
  1.  S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q "-1^patient data missing"
  1.  Q:'$L(FHADTX) "-1^patient assessment date missing"
  1.  Q:+FHADTX=FHADTX "-1^expecting the external format for a date/time"
  1.  Q:'$D(^FHPT(FHDFN,0)) "-1^invalid patient (not in Dietetics Patient file)"
  1.  N FHADTI,FHADTINV D DT^DILF("T",FHADTX,.FHADTI)
  1.  Q:FHADTI=-1 "-1^invalid assessment date"
  1.  S FHADTINV=(9999999-FHADTI)
  1.  Q:'$D(^FHPT(FHDFN,"N",FHADTINV,0)) "-1^No assessments on file for this date/time"
  1.  K ^TMP($J,"FHASM",DFN)
  1.  N ACIR,ACIRP,ADT,AGE,AMP,BFAMA,BFAMAP,BMI,BMIP,CCIR,CCIRP,CNT,DTP,DWGT
  1.  N FHAPPER,FHASMNT,FHLAB,FHUNIT,FLD,FRM,HGP,HGT,I,IBW,KCAL,N,NAM,NB,PRO
  1.  N RC,SCA,SCAP,SEX,STR,STR1,TAB,TSF,TSFP,UWGT,WGP,WGT,X,X1,X2,X3,XD,Y,Z
  1.  S CNT=0
  1.  ; Note: '^FH(119.9,1' is the Dietetics Site Parameter file!
  1.  S FHUNIT=$P($G(^FH(119.9,1,3)),"^") ; Eng. or Metric units of measure
  1.  S FHASMNT(0)=$G(^FHPT(FHDFN,"N",FHADTINV,0))
  1.  F I=1:1:22 S @$P("ADT SEX AGE HGT HGP WGT WGP DWGT UWGT IBW FRM AMP X X X KCAL PRO FLD RC XD BMI BMIP"," ",I)=$P(FHASMNT(0),"^",I)
  1.  S SIGN=$P(FHASMNT(0),U,23) S:SIGN'="" SIGN1="Entered by: "_$P($P(^VA(200,SIGN,0),U),",",2)_" "_$P($P(^VA(200,SIGN,0),U),",") K SIGN
  1.  S NAM=$P(^DPT(DFN,0),"^"),NB=$P(FHASMNT(0),"^",25)
  1.  S SEX=$S(SEX="M":"Male",SEX="F":"Female",1:"")
  1.  S FHASMNT(1)=$G(^FHPT(FHDFN,"N",FHADTINV,1))
  1.  F I=1:1:10 S @$P("TSF TSFP SCA SCAP ACIR ACIRP CCIR CCIRP BFAMA BFAMAP"," ",I)=$P(FHASMNT(1),"^",I)
  1.  S FHAPPER=$G(^FHPT(FHDFN,"N",FHADTINV,2)),I=0
  1.  F  S I=$O(^FHPT(FHDFN,"N",FHADTINV,"L",I)) Q:I'>0  S FHLAB(I)=$G(^(I,0))
  1.  D SETUP^FHWORA1
  1.  Q $S($D(^TMP($J,"FHASM",DFN)):1,1:"-1^No assessments on file for this date/time")
  1.  ;
  1. CNT(X) ; Increment our subscript
  1.  S X=X+1 S CNT=X
  1.  Q CNT
  1.  ;
  1. COMMENT ; Display the Nutritional Assessment comments.
  1.  S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=" "
  1.  S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))="Comments"
  1.  S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=" "
  1.  Q:'+$O(^FHPT(FHDFN,"N",FHADTINV,"X",0))  ; quit if no comments
  1.  N DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,FHI,X
  1.  S DIWF="",DIWL=1,DIWR=79 K ^UTILITY($J,"W",DIWL) S FHI=0
  1.  F  S FHI=$O(^FHPT(FHDFN,"N",FHADTINV,"X",FHI)) Q:FHI'>0  D
  1.  . S X=$G(^FHPT(FHDFN,"N",FHADTINV,"X",FHI,0)) D ^DIWP
  1.  . Q
  1.  S I=0 F  S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0  D
  1.  . S ^TMP($J,"FHASM",DFN,$$CNT(CNT))=$G(^UTILITY($J,"W",DIWL,I,0))
  1.  . Q
  1.  K ^UTILITY($J,"W",DIWL)
  1.  Q
  1.  ;
  1. LAB(I) ; Display lab data for our patient.
  1.  S X1=$P(FHLAB(I),"^",7) Q:X1=""  S DTP=X1\1 D DTP^FH
  1.  S:'X3 ^TMP($J,"FHASM",DFN,$$CNT(CNT))=" " ; initial linefeed
  1.  S X3=X3+1 ; lab data found? $S(X3>0:"Yes",1:"No")
  1.  K STR S $P(STR," ",81)="",TAB=5
  1.  S $E(STR,(TAB+1),(TAB+$L($P(FHLAB(I),"^"))))=$P(FHLAB(I),"^")
  1.  S TAB=27
  1.  S $E(STR,(TAB+1),(TAB+$L($P(FHLAB(I),"^",6))))=$P(FHLAB(I),"^",6)
  1.  S TAB=40
  1.  S $E(STR,(TAB+1),(TAB+$L($P(FHLAB(I),"^",4))))=$P(FHLAB(I),"^",4)
  1.  S TAB=51
  1.  S $E(STR,(TAB+1),(TAB+$L($P(FHLAB(I),"^",5))))=$P(FHLAB(I),"^",5)
  1.  S TAB=65,$E(STR,(TAB+1),(TAB+$L(DTP)))=DTP
  1.  S ^TMP($J,"FHASM",DFN,$$CNT(CNT))=STR
  1.  Q
  1.  ;
  1. TRUNC(I) ; Set each node to no more than eighty (80) chars in length.
  1.  N A,B,C S A=$L(I(0)),B=A\80
  1.  F C=1:1:B S ^TMP($J,"FHASM",DFN,$$CNT(CNT))=$E(I(0),$S(C=1:1,1:((C-1)*80)),((C*80)-1))
  1.  S ^TMP($J,"FHASM",DFN,$$CNT(CNT))=$E(I(0),(((80*B)+1)-1),A)
  1.  Q