DGPTLMU5 ;ALB/MTC - PTF A/P LIST MANAGER UTILITY CONT. ; 10-9-92
;;5.3;Registration;**606**;Aug 13, 1993
;
DI401 ;-- this function will load the 401 information
N X,X1,Y,I,J,DGDAT,DXD
S I=0 F S I=$O(^DGPT(DGPTF,"S",I)) Q:'I D
. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)="",DGDAT=$P(X,U)
. S X1="",X=$G(^DGPT(DGPTF,"S",I,0)) Q:X']""
. S Y="Surgery/Procedure Date :"_$S($P(X,U):$$FTIME^VALM1($P(X,U)),1:"")
. S X1=$$SETSTR^VALM1(Y,X1,1,40)
. S Y="Surg Specialty :"_$S($P(X,U,3):$P($G(^DIC(45.3,$P(X,U,3),0)),U,2),1:"")
. S X1=$$SETSTR^VALM1(Y,X1,45,30)
. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1
. S Y="Cat of Chief Surg :"_$S($P(X,U,4):$P($P($P(^DD(45.01,4,0),U,3),";",$P(X,U,4)),":",2),$P(X,U,4)="V":"VA TEAM",$P(X,U,4)="M":"MIXED VA&NON VA",$P(X,U,4)="N":"NON VA",1:"")
. S X1=$$SETSTR^VALM1(Y,X1,1,40)
. S Y="Cat of Frst Assist :"_$S($P(X,U,5):$P($P($P(^DD(45.01,5,0),U,3),";",$P(X,U,5)),":",2),1:"")
. S X1=$$SETSTR^VALM1(Y,X1,45,30)
. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1
. S Y="Prin Anest Tech :"_$S($P(X,U,6):$P($P($P(^DD(45.01,6,0),U,3),";",$P(X,U,6)),":",2),1:"NONE")
. S X1=$$SETSTR^VALM1(Y,X1,1,40)
. S Y="Source of Pay :"_$S($P(X,U,7):$P($P($P(^DD(45.01,7,0),U,3),";",$P(X,U,7)),":",2),1:"")
. S X1=$$SETSTR^VALM1(Y,X1,45,30)
. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1
.;
.;-- check for ICD codes
. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)="OPERATION CODES :"
. F J=8:1:12 I $P(X,U,J) D
.. S DXD=$$ICDOP^ICDCODE($P(X,U,J),DGDAT),Y=$P(DXD,U,2)_" - "_$P(DXD,U,5)
.. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=" "_Y
. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)="PROCEDURE CODES :",X3=$G(^DGPT(DGPTF,"401P"))
. I X3]"" F J=1:1:5 I $P(X3,U,J) D
.. S DXD=$$ICDOP^ICDCODE($P(X3,U,J),DGDAT),Y=$P(DXD,U,2)_" - "_$P(DXD,U,5)
.. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=" "_Y
.;
.;-- check for 300 node information
. S X2=$G(^DGPT(DGPTF,"S",I,300)) I X2]"" D
.. I +$P(X2,U) S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)="Kidney Source :"_$S($P(X2,U,2)=1:"Live Donor",1:"Cadaver")
Q
;
DI601 ;-- this function will load the 601 information
N X,X1,Y,I,J,DGDAT,DXD
S I=0 F S I=$O(^DGPT(DGPTF,"P",I)) Q:'I D
. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)="",DGDAT=$P(X,U)
. S X1="",X=$G(^DGPT(DGPTF,"P",I,0)) Q:X']""
. S Y="Procedure Date :"_$S($P(X,U):$$FTIME^VALM1($P(X,U)),1:"")
. S X1=$$SETSTR^VALM1(Y,X1,1,40)
. S Y="Specialty :"_$P($G(^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
. S Y="Dialysis Type :"_$P($G(^DG(45.4,+$P(X,U,3),0)),U,1)
. S X1=$$SETSTR^VALM1(Y,X1,1,40)
. S Y="Num of Dialysis Treat :"_$P(X,U,4)
. S X1=$$SETSTR^VALM1(Y,X1,45,30)
. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1
. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)="PROCEDURE CODES :"
. F J=5:1:9 I $P(X,U,J) D
.. S DXD=$$ICDOP^ICDCODE($P(X,U,J),DGDAT),Y=$P(DXD,U,2)_" - "_$P(DXD,U,5)
.. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=" "_Y
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTLMU5 3095 printed Sep 23, 2025@20:28:44 Page 2
DGPTLMU5 ;ALB/MTC - PTF A/P LIST MANAGER UTILITY CONT. ; 10-9-92
+1 ;;5.3;Registration;**606**;Aug 13, 1993
+2 ;
DI401 ;-- this function will load the 401 information
+1 NEW X,X1,Y,I,J,DGDAT,DXD
+2 SET I=0
FOR
SET I=$ORDER(^DGPT(DGPTF,"S",I))
if 'I
QUIT
Begin DoDot:1
+3 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=""
SET DGDAT=$PIECE(X,U)
+4 SET X1=""
SET X=$GET(^DGPT(DGPTF,"S",I,0))
if X']""
QUIT
+5 SET Y="Surgery/Procedure Date :"_$SELECT($PIECE(X,U):$$FTIME^VALM1($PIECE(X,U)),1:"")
+6 SET X1=$$SETSTR^VALM1(Y,X1,1,40)
+7 SET Y="Surg Specialty :"_$SELECT($PIECE(X,U,3):$PIECE($GET(^DIC(45.3,$PIECE(X,U,3),0)),U,2),1:"")
+8 SET X1=$$SETSTR^VALM1(Y,X1,45,30)
+9 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=X1
+10 SET Y="Cat of Chief Surg :"_$SELECT($PIECE(X,U,4):$PIECE($PIECE($PIECE(^DD(45.01,4,0),U,3),";",$PIECE(X,U,4)),":",2),$PIECE(X,U,4)="V":"VA TEAM",$PIECE(X,U,4)="M":"MIXED VA&NON VA",$PIECE(X,U,4)="N":"NON VA",1:"")
+11 SET X1=$$SETSTR^VALM1(Y,X1,1,40)
+12 SET Y="Cat of Frst Assist :"_$SELECT($PIECE(X,U,5):$PIECE($PIECE($PIECE(^DD(45.01,5,0),U,3),";",$PIECE(X,U,5)),":",2),1:"")
+13 SET X1=$$SETSTR^VALM1(Y,X1,45,30)
+14 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=X1
+15 SET Y="Prin Anest Tech :"_$SELECT($PIECE(X,U,6):$PIECE($PIECE($PIECE(^DD(45.01,6,0),U,3),";",$PIECE(X,U,6)),":",2),1:"NONE")
+16 SET X1=$$SETSTR^VALM1(Y,X1,1,40)
+17 SET Y="Source of Pay :"_$SELECT($PIECE(X,U,7):$PIECE($PIECE($PIECE(^DD(45.01,7,0),U,3),";",$PIECE(X,U,7)),":",2),1:"")
+18 SET X1=$$SETSTR^VALM1(Y,X1,45,30)
+19 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=X1
+20 ;
+21 ;-- check for ICD codes
+22 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)="OPERATION CODES :"
+23 FOR J=8:1:12
IF $PIECE(X,U,J)
Begin DoDot:2
+24 SET DXD=$$ICDOP^ICDCODE($PIECE(X,U,J),DGDAT)
SET Y=$PIECE(DXD,U,2)_" - "_$PIECE(DXD,U,5)
+25 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=" "_Y
End DoDot:2
+26 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)="PROCEDURE CODES :"
SET X3=$GET(^DGPT(DGPTF,"401P"))
+27 IF X3]""
FOR J=1:1:5
IF $PIECE(X3,U,J)
Begin DoDot:2
+28 SET DXD=$$ICDOP^ICDCODE($PIECE(X3,U,J),DGDAT)
SET Y=$PIECE(DXD,U,2)_" - "_$PIECE(DXD,U,5)
+29 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=" "_Y
End DoDot:2
+30 ;
+31 ;-- check for 300 node information
+32 SET X2=$GET(^DGPT(DGPTF,"S",I,300))
IF X2]""
Begin DoDot:2
+33 IF +$PIECE(X2,U)
SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)="Kidney Source :"_$SELECT($PIECE(X2,U,2)=1:"Live Donor",1:"Cadaver")
End DoDot:2
End DoDot:1
+34 QUIT
+35 ;
DI601 ;-- this function will load the 601 information
+1 NEW X,X1,Y,I,J,DGDAT,DXD
+2 SET I=0
FOR
SET I=$ORDER(^DGPT(DGPTF,"P",I))
if 'I
QUIT
Begin DoDot:1
+3 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=""
SET DGDAT=$PIECE(X,U)
+4 SET X1=""
SET X=$GET(^DGPT(DGPTF,"P",I,0))
if X']""
QUIT
+5 SET Y="Procedure Date :"_$SELECT($PIECE(X,U):$$FTIME^VALM1($PIECE(X,U)),1:"")
+6 SET X1=$$SETSTR^VALM1(Y,X1,1,40)
+7 SET Y="Specialty :"_$PIECE($GET(^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
+10 SET Y="Dialysis Type :"_$PIECE($GET(^DG(45.4,+$PIECE(X,U,3),0)),U,1)
+11 SET X1=$$SETSTR^VALM1(Y,X1,1,40)
+12 SET Y="Num of Dialysis Treat :"_$PIECE(X,U,4)
+13 SET X1=$$SETSTR^VALM1(Y,X1,45,30)
+14 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=X1
+15 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)="PROCEDURE CODES :"
+16 FOR J=5:1:9
IF $PIECE(X,U,J)
Begin DoDot:2
+17 SET DXD=$$ICDOP^ICDCODE($PIECE(X,U,J),DGDAT)
SET Y=$PIECE(DXD,U,2)_" - "_$PIECE(DXD,U,5)
+18 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=" "_Y
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
