- DGPTLMU5 ;ALB/MTC - PTF A/P LIST MANAGER UTILITY CONT. ; 10-9-92
- ;;5.3;Registration;**606,1015**;Aug 13, 1993;Build 21
- ;
- 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
- ;
- DGPTLMU5 ;ALB/MTC - PTF A/P LIST MANAGER UTILITY CONT. ; 10-9-92
- +1 ;;5.3;Registration;**606,1015**;Aug 13, 1993;Build 21
- +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 ;
