source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPTLMU5.m@ 1093

Last change on this file since 1093 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.0 KB
Line 
1DGPTLMU5 ;ALB/MTC - PTF A/P LIST MANAGER UTILITY CONT. ; 10-9-92
2 ;;5.3;Registration;**606**;Aug 13, 1993
3 ;
4DI401 ;-- this function will load the 401 information
5 N X,X1,Y,I,J,DGDAT,DXD
6 S I=0 F S I=$O(^DGPT(DGPTF,"S",I)) Q:'I D
7 . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)="",DGDAT=$P(X,U)
8 . S X1="",X=$G(^DGPT(DGPTF,"S",I,0)) Q:X']""
9 . S Y="Surgery/Procedure Date :"_$S($P(X,U):$$FTIME^VALM1($P(X,U)),1:"")
10 . S X1=$$SETSTR^VALM1(Y,X1,1,40)
11 . S Y="Surg Specialty :"_$S($P(X,U,3):$P($G(^DIC(45.3,$P(X,U,3),0)),U,2),1:"")
12 . S X1=$$SETSTR^VALM1(Y,X1,45,30)
13 . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1
14 . 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:"")
15 . S X1=$$SETSTR^VALM1(Y,X1,1,40)
16 . 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:"")
17 . S X1=$$SETSTR^VALM1(Y,X1,45,30)
18 . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1
19 . 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")
20 . S X1=$$SETSTR^VALM1(Y,X1,1,40)
21 . 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:"")
22 . S X1=$$SETSTR^VALM1(Y,X1,45,30)
23 . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1
24 .;
25 .;-- check for ICD codes
26 . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)="OPERATION CODES :"
27 . F J=8:1:12 I $P(X,U,J) D
28 .. S DXD=$$ICDOP^ICDCODE($P(X,U,J),DGDAT),Y=$P(DXD,U,2)_" - "_$P(DXD,U,5)
29 .. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=" "_Y
30 . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)="PROCEDURE CODES :",X3=$G(^DGPT(DGPTF,"401P"))
31 . I X3]"" F J=1:1:5 I $P(X3,U,J) D
32 .. S DXD=$$ICDOP^ICDCODE($P(X3,U,J),DGDAT),Y=$P(DXD,U,2)_" - "_$P(DXD,U,5)
33 .. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=" "_Y
34 .;
35 .;-- check for 300 node information
36 . S X2=$G(^DGPT(DGPTF,"S",I,300)) I X2]"" D
37 .. I +$P(X2,U) S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)="Kidney Source :"_$S($P(X2,U,2)=1:"Live Donor",1:"Cadaver")
38 Q
39 ;
40DI601 ;-- this function will load the 601 information
41 N X,X1,Y,I,J,DGDAT,DXD
42 S I=0 F S I=$O(^DGPT(DGPTF,"P",I)) Q:'I D
43 . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)="",DGDAT=$P(X,U)
44 . S X1="",X=$G(^DGPT(DGPTF,"P",I,0)) Q:X']""
45 . S Y="Procedure Date :"_$S($P(X,U):$$FTIME^VALM1($P(X,U)),1:"")
46 . S X1=$$SETSTR^VALM1(Y,X1,1,40)
47 . S Y="Specialty :"_$P($G(^DIC(42.4,+$P(X,U,2),0)),U,1)
48 . S X1=$$SETSTR^VALM1(Y,X1,45,30)
49 . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1
50 . S Y="Dialysis Type :"_$P($G(^DG(45.4,+$P(X,U,3),0)),U,1)
51 . S X1=$$SETSTR^VALM1(Y,X1,1,40)
52 . S Y="Num of Dialysis Treat :"_$P(X,U,4)
53 . S X1=$$SETSTR^VALM1(Y,X1,45,30)
54 . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1
55 . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)="PROCEDURE CODES :"
56 . F J=5:1:9 I $P(X,U,J) D
57 .. S DXD=$$ICDOP^ICDCODE($P(X,U,J),DGDAT),Y=$P(DXD,U,2)_" - "_$P(DXD,U,5)
58 .. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=" "_Y
59 Q
60 ;
Note: See TracBrowser for help on using the repository browser.