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

DGPTLMU4.m

Go to the documentation of this file. 
  1. DGPTLMU4 ;ALB/MTC/ADL - PTF A/P LIST MANAGER UTILITY CONT. ; 9-24-92
  1.  ;;5.3;Registration;**510,1015**;Aug 13, 1993;Build 21
  1.  ;;ADL;;Update for CSV Project;;Mar 27, 2003
  1.  ;
  1. EN ;-- single PTF record entry point
  1.  ; INPUT - DGPTF record to display
  1.  K ^TMP("ARCPTFDI",$J)
  1.  D EN^VALM("DGPT DETAILED INQUIRY")
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. DIEX ;-- exit code 
  1.  K ^TMP("ARCPTFDI",$J),DGPTF
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. DIHEAD ;-- header code
  1.  S VALMHDR(1)="Patient Name: "_$P(^DPT(+^DGPT(DGPTF,0),0),U)
  1.  S VALMHDR(2)="PTF record # :"_DGPTF
  1.  S VALMHDR(3)="Admission Date :"_$$FTIME^VALM1($P(^DGPT(DGPTF,0),U,2))
  1.  Q
  1.  ;
  1. DIEN ;-- list manager entry point
  1.  D SEL^DGPTLMU3
  1.  S DGPTF=+$O(VALMY(0))
  1.  I ('$D(^DGPT(DGPTF))!('$D(^TMP("ARCPTF",$J,"LIST","REC",DGPTF)))) S VALMBCK="" D  G DIENQ
  1.  . W !,">>> Invalid selection"
  1.  D EN^VALM("DGPT DETAILED INQUIRY")
  1.  S VALMBCK="R"
  1. DIENQ Q
  1.  ;
  1. DIINT ;-- This function will load the array containing the
  1.  ; PTF detailed information.
  1.  ;  INPUT : DGPTF - Valid PTF entry
  1.  ;
  1.  N I,J,X,Y,DGINC,X1,X2,NUMREC
  1.  S NUMREC=0,X1=""
  1.  S Y="Patient Name :"_$P(^DPT(+^DGPT(DGPTF,0),0),U)
  1.  S X1=$$SETSTR^VALM1(Y,X1,1,40)
  1.  S Y="PTF Record # :"_DGPTF
  1.  S X1=$$SETSTR^VALM1(Y,X1,45,30)
  1.  S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)=X1,X1=""
  1.  S Y="Admin Date :"_$$FTIME^VALM1($P(^DGPT(DGPTF,0),U,2))
  1.  S X1=$$SETSTR^VALM1(Y,X1,1,40),DG70=$G(^DGPT(DGPTF,70))
  1.  S Y="Disch Date :"_$S(+DG70:$$FTIME^VALM1(+DG70),1:"<UNKNOWN>")
  1.  S X1=$$SETSTR^VALM1(Y,X1,45,30)
  1.  S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)=X1,X1=""
  1.  S Y="Disch Specialty :"_$S($P(DG70,U,2):$P(^DIC(42.4,$P(DG70,U,2),0),U),1:"")
  1.  S X1=$$SETSTR^VALM1(Y,X1,1,40),X=$P(DG70,U,3)
  1.  S Y="Type of Dispos :"_$S(X:$P($P($P(^DD(45,72,0),U,3),";",X),":",2),1:"")
  1.  S X1=$$SETSTR^VALM1(Y,X1,45,30)
  1.  S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)=X1,X1="",X=$P(DG70,U,14)
  1.  S Y="Disch Status :"_$S(X:$P($P($P(^DD(45,72.1,0),U,3),";",X),":",2),1:"")
  1.  S X1=$$SETSTR^VALM1(Y,X1,1,40),X=$P(DG70,U,4)
  1.  S Y="Outpatient Treatment :"_$S(X=1:"YES",1:"NO")
  1.  S X1=$$SETSTR^VALM1(Y,X1,45,30)
  1.  S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)=X1,X1=""
  1.  S Y="ASIH Days :"_$S($P(DG70,U,8)]"":$P(DG70,U,8),1:"")
  1.  S X1=$$SETSTR^VALM1(Y,X1,1,40),X=$P(DG70,U,9)
  1.  S Y="C&P Status :"_$S(X:$P($P($P(^DD(45,78,0),U,3),";",X),":",2),1:"")
  1.  S X1=$$SETSTR^VALM1(Y,X1,45,30)
  1.  S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)=X1,X1=""
  1.  S Y="VA Auspices :"_$S($P(DG70,U,5)=1:"YES",1:"NO")
  1.  S X1=$$SETSTR^VALM1(Y,X1,1,40)
  1.  S DGINC=$P($G(^DGPT(DGPTF,101)),U,7) I DGINC>1000 S DGINC=$E(DGINC,1,$L(DGINC)-3)_","_$E(DGINC,$L(DGINC)-2,$L(DGINC))
  1.  S Y="Income :"_$S(DGINC]"":"$"_DGINC,1:"")
  1.  S X1=$$SETSTR^VALM1(Y,X1,45,30)
  1.  S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)=X1
  1.  ;-- check for ICD codes
  1.  S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)="ICD CODES :"
  1.  F J=10,15:1:24 I $P(DG70,U,J) D
  1.  . S DGPTTMP=$$ICDDX^ICDCODE(+$P(DG70,U,J),$$GETDATE^ICDGTDRG(DGPTF))
  1.  . S Y=$P(DGPTTMP,U,2)_" - "_$P(DGPTTMP,U,4)
  1.  . S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)=" "_Y
  1.  ;
  1.  ;-- check for 300 node information
  1.  S X2=$G(^DGPT(DGPTF,300)) I X2]"" D DI300(X2)
  1.  ;
  1.  D DI501^DGPTLMU6,DI401^DGPTLMU5,DI601^DGPTLMU5,DI535^DGPTLMU6
  1.  F X=1:1:NUMREC S ^TMP("ARCPTFDI",$J,"IDX",X,X)=""
  1.  S VALMCNT=NUMREC
  1.  Q
  1.  ;
  1. DI300(X2) ;-- load 300 node information
  1.  ; INPUT X2 - Contains 300 node
  1.  ; OUTPUT   - Load display array
  1.  ;
  1.  N X3,Y
  1.  I +$P(X2,U,2) S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)="Suicide Indicator :"_$S($P(X2,U,2)=1:"Attempted",1:"Accomplished")
  1.  I +$P(X2,U,3) S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)="Legionnaire's Disease :"_$S($P(X2,U,3)=1:"YES",1:"NO")
  1.  I +$P(X2,U,4) S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)="Abused Substance :"_$P($G(^DIC(45.61,$P(X2,U,4),0)),U)
  1.  I $P(X2,U,5)]"" D
  1.  . S Y="Psychiatry Classification Severity :",X3=$P(X2,U,5)
  1.  . S Y=Y_$S(X3]"":$P($P($P(^DD(45.02,300.05,0),U,3),";",X3),":",2),1:"")
  1.  . S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)=Y
  1.  I $P(X2,U,6)]"" S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)="Current Psychiatry Classification Assesment :"_$P(X2,U,6)
  1.  I $P(X2,U,7)]"" S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)="Highest Level Psychiatry Classification :"_$P(X2,U,7)
  1.  Q
  1.  ;
  1. NUM(X) ;-- increment function
  1.  ; INPUT : X -number to increment
  1.  ;OUTPUT : X+1
  1.  S X=X+1
  1.  Q X