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

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

initial load of FOIAVistA 6/30/08 version
File size: 2.6 KB
Line 
1DGPTLMU6 ;ALB/MTC - PTF A/P LIST MANAGER UTILITY CONT. ; 9-24-92
2 ;;5.3;Registration;**606**;Aug 13, 1993
3 ;
4DI501 ;-- this function will load the 501 information into the display array
5 N X,Y,I,J
6 S I=0 F S I=$O(^DGPT(DGPTF,"M",I)) Q:'I D
7 . S X1="",X=$G(^DGPT(DGPTF,"M",I,0)) Q:X']""
8 . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=""
9 . S Y="Movement Dt :"_$S($P(X,U,10):$$FTIME^VALM1($P(X,U,10)),1:"")
10 . S X1=$$SETSTR^VALM1(Y,X1,1,40)
11 . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1,X1=""
12 . S Y="Treated for SC condit :"_$S($P(X,U,18)=1:"YES",1:"NO")
13 . S X1=$$SETSTR^VALM1(Y,X1,1,40)
14 . S Y="Treated for AO condit :"_$S($P(X,U,26)=1:"YES",1:"NO")
15 . S X1=$$SETSTR^VALM1(Y,X1,45,30)
16 . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1,X1=""
17 . S Y="Treated for IR condit :"_$S($P(X,U,27)=1:"YES",1:"NO")
18 . S X1=$$SETSTR^VALM1(Y,X1,1,40)
19 . S Y="Treated for EC condit :"_$S($P(X,U,28)=1:"YES",1:"NO")
20 . S X1=$$SETSTR^VALM1(Y,X1,45,30)
21 . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1,X1=""
22 . S Y="Leave Days :"_$S($P(X,U,3):$P(X,U,3),1:"")
23 . S X1=$$SETSTR^VALM1(Y,X1,1,40)
24 . S Y="Pass Days :"_$S($P(X,U,4):$P(X,U,4),1:"")
25 . S X1=$$SETSTR^VALM1(Y,X1,45,30)
26 . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1,X1=""
27 . S Y="Losing Specialty :"_$S($P(X,U,2):$P(^DIC(42.4,$P(X,U,2),0),U),1:"")
28 . S X1=$$SETSTR^VALM1(Y,X1,1,75)
29 . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1,X1=""
30 .;
31 .;-- check for ICD codes
32 . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)="ICD CODES :"
33 . F J=5:1:9,11:1:15 I $P(X,U,J) D
34 .. S Y=$$ICDDX^ICDCODE($P(X,U,J),$P(X,U,10)),Y=$P(Y,U,2)_" - "_$P(Y,U,4)
35 .. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=" "_Y
36 .;
37 .;-- check for 300 node information
38 .;
39 . S X2=$G(^DGPT(DGPTF,"M",I,300)) I X2]"" D DI300^DGPTLMU4(X2)
40 Q
41 ;
42DI535 ;-- this function will load the 535 information
43 N Y,X,X1,DG535
44 S DG535=0 F S DG535=$O(^DGPT(DGPTF,535,DG535)) Q:'DG535 D
45 . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=""
46 . S X=$G(^DGPT(DGPTF,535,DG535,0)),X1=""
47 . S Y="Ward Movement Date :"_$S($P(X,U,10):$$FTIME^VALM1($P(X,U,10)),1:"")
48 . S X1=$$SETSTR^VALM1(Y,X1,1,40)
49 . S Y="Losing Ward Specialty :"_$P(^DIC(42.4,$P(X,U,2),0),U,1)
50 . S X1=$$SETSTR^VALM1(Y,X1,45,30)
51 . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1,X1=""
52 . S Y="Leave Days : "_$P(X,U,3)
53 . S X1=$$SETSTR^VALM1(Y,X1,1,40)
54 . S Y="Pass Days :"_$P(X,U,4)
55 . S X1=$$SETSTR^VALM1(Y,X1,45,30)
56 . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1,X1=""
57 . S Y="Losing Ward : "_$P(^DIC(42,$P(X,U,6),0),U)
58 . S X1=$$SETSTR^VALM1(Y,X1,1,40)
59 . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1,X1=""
60 Q
61 ;
Note: See TracBrowser for help on using the repository browser.