DGPTLMU4 ;ALB/MTC/ADL - PTF A/P LIST MANAGER UTILITY CONT. ; 9-24-92
;;5.3;Registration;**510**;Aug 13, 1993
;;ADL;;Update for CSV Project;;Mar 27, 2003
;
EN ;-- single PTF record entry point
; INPUT - DGPTF record to display
K ^TMP("ARCPTFDI",$J)
D EN^VALM("DGPT DETAILED INQUIRY")
D CLEAR^VALM1
Q
;
DIEX ;-- exit code
K ^TMP("ARCPTFDI",$J),DGPTF
D CLEAR^VALM1
Q
;
DIHEAD ;-- header code
S VALMHDR(1)="Patient Name: "_$P(^DPT(+^DGPT(DGPTF,0),0),U)
S VALMHDR(2)="PTF record # :"_DGPTF
S VALMHDR(3)="Admission Date :"_$$FTIME^VALM1($P(^DGPT(DGPTF,0),U,2))
Q
;
DIEN ;-- list manager entry point
D SEL^DGPTLMU3
S DGPTF=+$O(VALMY(0))
I ('$D(^DGPT(DGPTF))!('$D(^TMP("ARCPTF",$J,"LIST","REC",DGPTF)))) S VALMBCK="" D G DIENQ
. W !,">>> Invalid selection"
D EN^VALM("DGPT DETAILED INQUIRY")
S VALMBCK="R"
DIENQ Q
;
DIINT ;-- This function will load the array containing the
; PTF detailed information.
; INPUT : DGPTF - Valid PTF entry
;
N I,J,X,Y,DGINC,X1,X2,NUMREC
S NUMREC=0,X1=""
S Y="Patient Name :"_$P(^DPT(+^DGPT(DGPTF,0),0),U)
S X1=$$SETSTR^VALM1(Y,X1,1,40)
S Y="PTF Record # :"_DGPTF
S X1=$$SETSTR^VALM1(Y,X1,45,30)
S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)=X1,X1=""
S Y="Admin Date :"_$$FTIME^VALM1($P(^DGPT(DGPTF,0),U,2))
S X1=$$SETSTR^VALM1(Y,X1,1,40),DG70=$G(^DGPT(DGPTF,70))
S Y="Disch Date :"_$S(+DG70:$$FTIME^VALM1(+DG70),1:"<UNKNOWN>")
S X1=$$SETSTR^VALM1(Y,X1,45,30)
S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)=X1,X1=""
S Y="Disch Specialty :"_$S($P(DG70,U,2):$P(^DIC(42.4,$P(DG70,U,2),0),U),1:"")
S X1=$$SETSTR^VALM1(Y,X1,1,40),X=$P(DG70,U,3)
S Y="Type of Dispos :"_$S(X:$P($P($P(^DD(45,72,0),U,3),";",X),":",2),1:"")
S X1=$$SETSTR^VALM1(Y,X1,45,30)
S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)=X1,X1="",X=$P(DG70,U,14)
S Y="Disch Status :"_$S(X:$P($P($P(^DD(45,72.1,0),U,3),";",X),":",2),1:"")
S X1=$$SETSTR^VALM1(Y,X1,1,40),X=$P(DG70,U,4)
S Y="Outpatient Treatment :"_$S(X=1:"YES",1:"NO")
S X1=$$SETSTR^VALM1(Y,X1,45,30)
S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)=X1,X1=""
S Y="ASIH Days :"_$S($P(DG70,U,8)]"":$P(DG70,U,8),1:"")
S X1=$$SETSTR^VALM1(Y,X1,1,40),X=$P(DG70,U,9)
S Y="C&P Status :"_$S(X:$P($P($P(^DD(45,78,0),U,3),";",X),":",2),1:"")
S X1=$$SETSTR^VALM1(Y,X1,45,30)
S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)=X1,X1=""
S Y="VA Auspices :"_$S($P(DG70,U,5)=1:"YES",1:"NO")
S X1=$$SETSTR^VALM1(Y,X1,1,40)
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))
S Y="Income :"_$S(DGINC]"":"$"_DGINC,1:"")
S X1=$$SETSTR^VALM1(Y,X1,45,30)
S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)=X1
;-- check for ICD codes
S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)="ICD CODES :"
F J=10,15:1:24 I $P(DG70,U,J) D
. S DGPTTMP=$$ICDDX^ICDCODE(+$P(DG70,U,J),$$GETDATE^ICDGTDRG(DGPTF))
. S Y=$P(DGPTTMP,U,2)_" - "_$P(DGPTTMP,U,4)
. S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)=" "_Y
;
;-- check for 300 node information
S X2=$G(^DGPT(DGPTF,300)) I X2]"" D DI300(X2)
;
D DI501^DGPTLMU6,DI401^DGPTLMU5,DI601^DGPTLMU5,DI535^DGPTLMU6
F X=1:1:NUMREC S ^TMP("ARCPTFDI",$J,"IDX",X,X)=""
S VALMCNT=NUMREC
Q
;
DI300(X2) ;-- load 300 node information
; INPUT X2 - Contains 300 node
; OUTPUT - Load display array
;
N X3,Y
I +$P(X2,U,2) S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)="Suicide Indicator :"_$S($P(X2,U,2)=1:"Attempted",1:"Accomplished")
I +$P(X2,U,3) S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)="Legionnaire's Disease :"_$S($P(X2,U,3)=1:"YES",1:"NO")
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)
I $P(X2,U,5)]"" D
. S Y="Psychiatry Classification Severity :",X3=$P(X2,U,5)
. S Y=Y_$S(X3]"":$P($P($P(^DD(45.02,300.05,0),U,3),";",X3),":",2),1:"")
. S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)=Y
I $P(X2,U,6)]"" S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)="Current Psychiatry Classification Assesment :"_$P(X2,U,6)
I $P(X2,U,7)]"" S ^TMP("ARCPTFDI",$J,$$NUM(.NUMREC),0)="Highest Level Psychiatry Classification :"_$P(X2,U,7)
Q
;
NUM(X) ;-- increment function
; INPUT : X -number to increment
;OUTPUT : X+1
S X=X+1
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTLMU4 4189 printed Dec 13, 2024@02:52:50 Page 2
DGPTLMU4 ;ALB/MTC/ADL - PTF A/P LIST MANAGER UTILITY CONT. ; 9-24-92
+1 ;;5.3;Registration;**510**;Aug 13, 1993
+2 ;;ADL;;Update for CSV Project;;Mar 27, 2003
+3 ;
EN ;-- single PTF record entry point
+1 ; INPUT - DGPTF record to display
+2 KILL ^TMP("ARCPTFDI",$JOB)
+3 DO EN^VALM("DGPT DETAILED INQUIRY")
+4 DO CLEAR^VALM1
+5 QUIT
+6 ;
DIEX ;-- exit code
+1 KILL ^TMP("ARCPTFDI",$JOB),DGPTF
+2 DO CLEAR^VALM1
+3 QUIT
+4 ;
DIHEAD ;-- header code
+1 SET VALMHDR(1)="Patient Name: "_$PIECE(^DPT(+^DGPT(DGPTF,0),0),U)
+2 SET VALMHDR(2)="PTF record # :"_DGPTF
+3 SET VALMHDR(3)="Admission Date :"_$$FTIME^VALM1($PIECE(^DGPT(DGPTF,0),U,2))
+4 QUIT
+5 ;
DIEN ;-- list manager entry point
+1 DO SEL^DGPTLMU3
+2 SET DGPTF=+$ORDER(VALMY(0))
+3 IF ('$DATA(^DGPT(DGPTF))!('$DATA(^TMP("ARCPTF",$JOB,"LIST","REC",DGPTF))))
SET VALMBCK=""
Begin DoDot:1
+4 WRITE !,">>> Invalid selection"
End DoDot:1
GOTO DIENQ
+5 DO EN^VALM("DGPT DETAILED INQUIRY")
+6 SET VALMBCK="R"
DIENQ QUIT
+1 ;
DIINT ;-- This function will load the array containing the
+1 ; PTF detailed information.
+2 ; INPUT : DGPTF - Valid PTF entry
+3 ;
+4 NEW I,J,X,Y,DGINC,X1,X2,NUMREC
+5 SET NUMREC=0
SET X1=""
+6 SET Y="Patient Name :"_$PIECE(^DPT(+^DGPT(DGPTF,0),0),U)
+7 SET X1=$$SETSTR^VALM1(Y,X1,1,40)
+8 SET Y="PTF Record # :"_DGPTF
+9 SET X1=$$SETSTR^VALM1(Y,X1,45,30)
+10 SET ^TMP("ARCPTFDI",$JOB,$$NUM(.NUMREC),0)=X1
SET X1=""
+11 SET Y="Admin Date :"_$$FTIME^VALM1($PIECE(^DGPT(DGPTF,0),U,2))
+12 SET X1=$$SETSTR^VALM1(Y,X1,1,40)
SET DG70=$GET(^DGPT(DGPTF,70))
+13 SET Y="Disch Date :"_$SELECT(+DG70:$$FTIME^VALM1(+DG70),1:"<UNKNOWN>")
+14 SET X1=$$SETSTR^VALM1(Y,X1,45,30)
+15 SET ^TMP("ARCPTFDI",$JOB,$$NUM(.NUMREC),0)=X1
SET X1=""
+16 SET Y="Disch Specialty :"_$SELECT($PIECE(DG70,U,2):$PIECE(^DIC(42.4,$PIECE(DG70,U,2),0),U),1:"")
+17 SET X1=$$SETSTR^VALM1(Y,X1,1,40)
SET X=$PIECE(DG70,U,3)
+18 SET Y="Type of Dispos :"_$SELECT(X:$PIECE($PIECE($PIECE(^DD(45,72,0),U,3),";",X),":",2),1:"")
+19 SET X1=$$SETSTR^VALM1(Y,X1,45,30)
+20 SET ^TMP("ARCPTFDI",$JOB,$$NUM(.NUMREC),0)=X1
SET X1=""
SET X=$PIECE(DG70,U,14)
+21 SET Y="Disch Status :"_$SELECT(X:$PIECE($PIECE($PIECE(^DD(45,72.1,0),U,3),";",X),":",2),1:"")
+22 SET X1=$$SETSTR^VALM1(Y,X1,1,40)
SET X=$PIECE(DG70,U,4)
+23 SET Y="Outpatient Treatment :"_$SELECT(X=1:"YES",1:"NO")
+24 SET X1=$$SETSTR^VALM1(Y,X1,45,30)
+25 SET ^TMP("ARCPTFDI",$JOB,$$NUM(.NUMREC),0)=X1
SET X1=""
+26 SET Y="ASIH Days :"_$SELECT($PIECE(DG70,U,8)]"":$PIECE(DG70,U,8),1:"")
+27 SET X1=$$SETSTR^VALM1(Y,X1,1,40)
SET X=$PIECE(DG70,U,9)
+28 SET Y="C&P Status :"_$SELECT(X:$PIECE($PIECE($PIECE(^DD(45,78,0),U,3),";",X),":",2),1:"")
+29 SET X1=$$SETSTR^VALM1(Y,X1,45,30)
+30 SET ^TMP("ARCPTFDI",$JOB,$$NUM(.NUMREC),0)=X1
SET X1=""
+31 SET Y="VA Auspices :"_$SELECT($PIECE(DG70,U,5)=1:"YES",1:"NO")
+32 SET X1=$$SETSTR^VALM1(Y,X1,1,40)
+33 SET DGINC=$PIECE($GET(^DGPT(DGPTF,101)),U,7)
IF DGINC>1000
SET DGINC=$EXTRACT(DGINC,1,$LENGTH(DGINC)-3)_","_$EXTRACT(DGINC,$LENGTH(DGINC)-2,$LENGTH(DGINC))
+34 SET Y="Income :"_$SELECT(DGINC]"":"$"_DGINC,1:"")
+35 SET X1=$$SETSTR^VALM1(Y,X1,45,30)
+36 SET ^TMP("ARCPTFDI",$JOB,$$NUM(.NUMREC),0)=X1
+37 ;-- check for ICD codes
+38 SET ^TMP("ARCPTFDI",$JOB,$$NUM(.NUMREC),0)="ICD CODES :"
+39 FOR J=10,15:1:24
IF $PIECE(DG70,U,J)
Begin DoDot:1
+40 SET DGPTTMP=$$ICDDX^ICDCODE(+$PIECE(DG70,U,J),$$GETDATE^ICDGTDRG(DGPTF))
+41 SET Y=$PIECE(DGPTTMP,U,2)_" - "_$PIECE(DGPTTMP,U,4)
+42 SET ^TMP("ARCPTFDI",$JOB,$$NUM(.NUMREC),0)=" "_Y
End DoDot:1
+43 ;
+44 ;-- check for 300 node information
+45 SET X2=$GET(^DGPT(DGPTF,300))
IF X2]""
DO DI300(X2)
+46 ;
+47 DO DI501^DGPTLMU6
DO DI401^DGPTLMU5
DO DI601^DGPTLMU5
DO DI535^DGPTLMU6
+48 FOR X=1:1:NUMREC
SET ^TMP("ARCPTFDI",$JOB,"IDX",X,X)=""
+49 SET VALMCNT=NUMREC
+50 QUIT
+51 ;
DI300(X2) ;-- load 300 node information
+1 ; INPUT X2 - Contains 300 node
+2 ; OUTPUT - Load display array
+3 ;
+4 NEW X3,Y
+5 IF +$PIECE(X2,U,2)
SET ^TMP("ARCPTFDI",$JOB,$$NUM(.NUMREC),0)="Suicide Indicator :"_$SELECT($PIECE(X2,U,2)=1:"Attempted",1:"Accomplished")
+6 IF +$PIECE(X2,U,3)
SET ^TMP("ARCPTFDI",$JOB,$$NUM(.NUMREC),0)="Legionnaire's Disease :"_$SELECT($PIECE(X2,U,3)=1:"YES",1:"NO")
+7 IF +$PIECE(X2,U,4)
SET ^TMP("ARCPTFDI",$JOB,$$NUM(.NUMREC),0)="Abused Substance :"_$PIECE($GET(^DIC(45.61,$PIECE(X2,U,4),0)),U)
+8 IF $PIECE(X2,U,5)]""
Begin DoDot:1
+9 SET Y="Psychiatry Classification Severity :"
SET X3=$PIECE(X2,U,5)
+10 SET Y=Y_$SELECT(X3]"":$PIECE($PIECE($PIECE(^DD(45.02,300.05,0),U,3),";",X3),":",2),1:"")
+11 SET ^TMP("ARCPTFDI",$JOB,$$NUM(.NUMREC),0)=Y
End DoDot:1
+12 IF $PIECE(X2,U,6)]""
SET ^TMP("ARCPTFDI",$JOB,$$NUM(.NUMREC),0)="Current Psychiatry Classification Assesment :"_$PIECE(X2,U,6)
+13 IF $PIECE(X2,U,7)]""
SET ^TMP("ARCPTFDI",$JOB,$$NUM(.NUMREC),0)="Highest Level Psychiatry Classification :"_$PIECE(X2,U,7)
+14 QUIT
+15 ;
NUM(X) ;-- increment function
+1 ; INPUT : X -number to increment
+2 ;OUTPUT : X+1
+3 SET X=X+1
+4 QUIT X
