DGPTLMU6 ;ALB/MTC - PTF A/P LIST MANAGER UTILITY CONT. ; 9-24-92
;;5.3;Registration;**606**;Aug 13, 1993
;
DI501 ;-- this function will load the 501 information into the display array
N X,Y,I,J
S I=0 F S I=$O(^DGPT(DGPTF,"M",I)) Q:'I D
. S X1="",X=$G(^DGPT(DGPTF,"M",I,0)) Q:X']""
. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=""
. S Y="Movement Dt :"_$S($P(X,U,10):$$FTIME^VALM1($P(X,U,10)),1:"")
. S X1=$$SETSTR^VALM1(Y,X1,1,40)
. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1,X1=""
. S Y="Treated for SC condit :"_$S($P(X,U,18)=1:"YES",1:"NO")
. S X1=$$SETSTR^VALM1(Y,X1,1,40)
. S Y="Treated for AO condit :"_$S($P(X,U,26)=1:"YES",1:"NO")
. S X1=$$SETSTR^VALM1(Y,X1,45,30)
. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1,X1=""
. S Y="Treated for IR condit :"_$S($P(X,U,27)=1:"YES",1:"NO")
. S X1=$$SETSTR^VALM1(Y,X1,1,40)
. S Y="Treated for EC condit :"_$S($P(X,U,28)=1:"YES",1:"NO")
. S X1=$$SETSTR^VALM1(Y,X1,45,30)
. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1,X1=""
. S Y="Leave Days :"_$S($P(X,U,3):$P(X,U,3),1:"")
. S X1=$$SETSTR^VALM1(Y,X1,1,40)
. S Y="Pass Days :"_$S($P(X,U,4):$P(X,U,4),1:"")
. S X1=$$SETSTR^VALM1(Y,X1,45,30)
. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1,X1=""
. S Y="Losing Specialty :"_$S($P(X,U,2):$P(^DIC(42.4,$P(X,U,2),0),U),1:"")
. S X1=$$SETSTR^VALM1(Y,X1,1,75)
. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1,X1=""
.;
.;-- check for ICD codes
. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)="ICD CODES :"
. F J=5:1:9,11:1:15 I $P(X,U,J) D
.. S Y=$$ICDDX^ICDCODE($P(X,U,J),$P(X,U,10)),Y=$P(Y,U,2)_" - "_$P(Y,U,4)
.. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=" "_Y
.;
.;-- check for 300 node information
.;
. S X2=$G(^DGPT(DGPTF,"M",I,300)) I X2]"" D DI300^DGPTLMU4(X2)
Q
;
DI535 ;-- this function will load the 535 information
N Y,X,X1,DG535
S DG535=0 F S DG535=$O(^DGPT(DGPTF,535,DG535)) Q:'DG535 D
. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=""
. S X=$G(^DGPT(DGPTF,535,DG535,0)),X1=""
. S Y="Ward Movement Date :"_$S($P(X,U,10):$$FTIME^VALM1($P(X,U,10)),1:"")
. S X1=$$SETSTR^VALM1(Y,X1,1,40)
. S Y="Losing Ward Specialty :"_$P(^DIC(42.4,$P(X,U,2),0),U,1)
. S X1=$$SETSTR^VALM1(Y,X1,45,30)
. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1,X1=""
. S Y="Leave Days : "_$P(X,U,3)
. S X1=$$SETSTR^VALM1(Y,X1,1,40)
. S Y="Pass Days :"_$P(X,U,4)
. S X1=$$SETSTR^VALM1(Y,X1,45,30)
. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1,X1=""
. S Y="Losing Ward : "_$P(^DIC(42,$P(X,U,6),0),U)
. S X1=$$SETSTR^VALM1(Y,X1,1,40)
. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1,X1=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTLMU6 2693 printed Sep 23, 2025@20:28:45 Page 2
DGPTLMU6 ;ALB/MTC - PTF A/P LIST MANAGER UTILITY CONT. ; 9-24-92
+1 ;;5.3;Registration;**606**;Aug 13, 1993
+2 ;
DI501 ;-- this function will load the 501 information into the display array
+1 NEW X,Y,I,J
+2 SET I=0
FOR
SET I=$ORDER(^DGPT(DGPTF,"M",I))
if 'I
QUIT
Begin DoDot:1
+3 SET X1=""
SET X=$GET(^DGPT(DGPTF,"M",I,0))
if X']""
QUIT
+4 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=""
+5 SET Y="Movement Dt :"_$SELECT($PIECE(X,U,10):$$FTIME^VALM1($PIECE(X,U,10)),1:"")
+6 SET X1=$$SETSTR^VALM1(Y,X1,1,40)
+7 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=X1
SET X1=""
+8 SET Y="Treated for SC condit :"_$SELECT($PIECE(X,U,18)=1:"YES",1:"NO")
+9 SET X1=$$SETSTR^VALM1(Y,X1,1,40)
+10 SET Y="Treated for AO condit :"_$SELECT($PIECE(X,U,26)=1:"YES",1:"NO")
+11 SET X1=$$SETSTR^VALM1(Y,X1,45,30)
+12 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=X1
SET X1=""
+13 SET Y="Treated for IR condit :"_$SELECT($PIECE(X,U,27)=1:"YES",1:"NO")
+14 SET X1=$$SETSTR^VALM1(Y,X1,1,40)
+15 SET Y="Treated for EC condit :"_$SELECT($PIECE(X,U,28)=1:"YES",1:"NO")
+16 SET X1=$$SETSTR^VALM1(Y,X1,45,30)
+17 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=X1
SET X1=""
+18 SET Y="Leave Days :"_$SELECT($PIECE(X,U,3):$PIECE(X,U,3),1:"")
+19 SET X1=$$SETSTR^VALM1(Y,X1,1,40)
+20 SET Y="Pass Days :"_$SELECT($PIECE(X,U,4):$PIECE(X,U,4),1:"")
+21 SET X1=$$SETSTR^VALM1(Y,X1,45,30)
+22 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=X1
SET X1=""
+23 SET Y="Losing Specialty :"_$SELECT($PIECE(X,U,2):$PIECE(^DIC(42.4,$PIECE(X,U,2),0),U),1:"")
+24 SET X1=$$SETSTR^VALM1(Y,X1,1,75)
+25 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=X1
SET X1=""
+26 ;
+27 ;-- check for ICD codes
+28 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)="ICD CODES :"
+29 FOR J=5:1:9,11:1:15
IF $PIECE(X,U,J)
Begin DoDot:2
+30 SET Y=$$ICDDX^ICDCODE($PIECE(X,U,J),$PIECE(X,U,10))
SET Y=$PIECE(Y,U,2)_" - "_$PIECE(Y,U,4)
+31 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=" "_Y
End DoDot:2
+32 ;
+33 ;-- check for 300 node information
+34 ;
+35 SET X2=$GET(^DGPT(DGPTF,"M",I,300))
IF X2]""
DO DI300^DGPTLMU4(X2)
End DoDot:1
+36 QUIT
+37 ;
DI535 ;-- this function will load the 535 information
+1 NEW Y,X,X1,DG535
+2 SET DG535=0
FOR
SET DG535=$ORDER(^DGPT(DGPTF,535,DG535))
if 'DG535
QUIT
Begin DoDot:1
+3 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=""
+4 SET X=$GET(^DGPT(DGPTF,535,DG535,0))
SET X1=""
+5 SET Y="Ward Movement Date :"_$SELECT($PIECE(X,U,10):$$FTIME^VALM1($PIECE(X,U,10)),1:"")
+6 SET X1=$$SETSTR^VALM1(Y,X1,1,40)
+7 SET Y="Losing Ward Specialty :"_$PIECE(^DIC(42.4,$PIECE(X,U,2),0),U,1)
+8 SET X1=$$SETSTR^VALM1(Y,X1,45,30)
+9 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=X1
SET X1=""
+10 SET Y="Leave Days : "_$PIECE(X,U,3)
+11 SET X1=$$SETSTR^VALM1(Y,X1,1,40)
+12 SET Y="Pass Days :"_$PIECE(X,U,4)
+13 SET X1=$$SETSTR^VALM1(Y,X1,45,30)
+14 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=X1
SET X1=""
+15 SET Y="Losing Ward : "_$PIECE(^DIC(42,$PIECE(X,U,6),0),U)
+16 SET X1=$$SETSTR^VALM1(Y,X1,1,40)
+17 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=X1
SET X1=""
End DoDot:1
+18 QUIT
+19 ;
