source: FOIAVistA/trunk/r/HEALTH_SUMMARY-GMTS/GMTSOBL2.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1GMTSOBL2 ; SLC/KER - HS Object - Lookup ; 01/06/2003
2 ;;2.7;Health Summary;**58**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 10006 ^DIC (file #142.5)
6 ; DBIA 10013 ^DIK (file #142 and 142.5)
7 ; DBIA 10016 ^DIM
8 ; DBIA 10103 $$NOW^XLFDT
9 ; DBIA 10103 $$FMADD^XLFDT
10 ;
11 Q
12N(X) ; Verify Name
13 N DA,DIK,GMTSIEN,GMTSNEW S GMTSIEN=+($G(X)),GMTSNEW=+($P($G(X),"^",3))
14 I GMTSIEN'>0!('$L($P($G(^GMT(142.5,+($G(X)),0)),"^",1))) D
15 . S DA=GMTSIEN,DIK="^GMT(142.5,"
16 . W !," 'NAME' is a required field" Q:'GMTSNEW
17 . D:DA>0 ^DIK S X=-1
18 . W:'$D(^GMT(142.5,+DA,0)) !," < Health Summary Object deleted >"
19 Q X
20NN(GMTS) ; No Name Entered
21 N DA,DIK,GMTSIEN,GMTSNEW S GMTSIEN=+($G(GMTS)),GMTSNEW=+($P($G(GMTS),"^",3))
22 I +GMTSIEN>0 D
23 . Q:$L($P($G(^GMT(142.5,+GMTSIEN,0)),"^",1))
24 . S DA=+GMTSIEN,DIK="^GMT(142.5,"
25 . W !," 'NAME' is a required field" Q:'GMTSNEW D:DA>0 ^DIK
26 . W:'$D(^GMT(142.5,+DA,0)) !," < Health Summary Object deleted >"
27 . S:'$D(^GMT(142.5,+DA,0)) (DA,X,Y)=-1,GMTSQ=1
28 Q
29T(X) ; Type
30 N GMTST,GMTSB,GMTSC,GMTSIEN,GMTSNEW S GMTSIEN=+($G(X)),GMTST=+($P($G(^GMT(142.5,GMTSIEN,0)),"^",3)),GMTSNEW=+($P($G(X),"^",3))
31 I GMTST=0 D Q X
32 . S DA=GMTSIEN,DIK="^GMT(142.5,"
33 . W !," 'Health Summary Type' is a required field" Q:'GMTSNEW
34 . D:DA>0 ^DIK S X=-1
35 . W !," < Health Summary Object deleted >"
36 S GMTSB=+($D(^GMT(142,GMTST,1,"B"))),GMTSB=$S(GMTSB>0:1,1:0)
37 I GMTSB=0 D Q X
38 . S DA=GMTSIEN,DIK="^GMT(142.5,"
39 . W !," Selected Health Summary Type has no Components" Q:'GMTSNEW
40 . D:DA>0 ^DIK S X=-1
41 . W !," < Health Summary Object deleted >"
42 S GMTSC=$O(^GMT(142,GMTST,1,"C",0)),GMTSC=$S(GMTSC<9999&(GMTSC>0):1,1:0)
43 Q X
44NT(GMTS) ; No Type Entered
45 N DA,DIK,GMTSIEN,GMTSNEW S GMTSIEN=+($G(GMTS)),GMTSNEW=+($P($G(GMTS),"^",3))
46 I +GMTSIEN>0 D
47 . Q:+($P($G(^GMT(142.5,+GMTSIEN,0)),"^",3))>0
48 . S DA=+GMTSIEN,DIK="^GMT(142.5,"
49 . W !," 'HEALTH SUMMARY TYPE' is a required field" Q:'GMTSNEW
50 . D:DA>0 ^DIK
51 . W:'$D(^GMT(142.5,+DA,0)) !," < Health Summary Object deleted >"
52 . S:'$D(^GMT(142.5,+DA,0)) (DA,X,Y)=-1,GMTSQ=1
53 Q
54NEW(GMTS) ; New
55 S GMTS=+($G(GMTS))
56 I +GMTS>0,$D(^GMT(142.5,GMTS,0)) D
57 . N GMTSDT S GMTSDT=$$NOW^XLFDT
58 . S $P(^GMT(142.5,+GMTS,0),"^",18)=GMTSDT
59 . S GMTSDT=$$FMADD^XLFDT(GMTSDT,,,1,)
60 . S $P(^GMT(142.5,+GMTS,0),"^",19)=GMTSDT
61 . Q:+($G(DUZ))'>0 S $P(^GMT(142.5,+GMTS,0),"^",17)=+($G(DUZ))
62 Q
63VER(X) ; Verify Object
64 N GMTSIEN,GMTSNAM,GMTSNEW S GMTSIEN=+($G(X)) Q:+GMTSIEN'>0 -1
65 S GMTSNAM=$P($G(X),"^",2),GMTSNEW=+($P($G(X),"^",3))
66 Q:'$D(^GMT(142.5,+GMTSIEN,0)) -1
67 I '$L($P($G(^GMT(142.5,+GMTSIEN,0)),"^",1)) D Q -1
68 . S DA=+GMTSIEN,DIK="^GMT(142.5," W !," 'NAME' is a required field" D:DA>0 ^DIK
69 . W:'$D(^GMT(142.5,+DA,0)) !," < Health Summary Object deleted >" S:'$D(^GMT(142.5,+DA,0)) (DA,X,Y)=-1,GMTSQ=1
70 Q:'$D(^GMT(142.5,+GMTSIEN,0)) -1
71 I +($P($G(^GMT(142.5,+GMTSIEN,0)),"^",3))'>0 D Q -1
72 . S DA=+GMTSIEN,DIK="^GMT(142.5," W !," 'HEALTH SUMMARY TYPE' is a required field" D:DA>0 ^DIK
73 . W:'$D(^GMT(142.5,+DA,0)) !," < Health Summary Object deleted >" S:'$D(^GMT(142.5,+DA,0)) (DA,X,Y)=-1,GMTSQ=1
74 Q:'$D(^GMT(142.5,+GMTSIEN,0)) -1
75 Q X
76MOD(GMTS) ; Modified
77 S GMTS=+($G(GMTS))
78 I +GMTS>0,$D(^GMT(142.5,GMTS,0)) D
79 . N GMTSDT S GMTSDT=$$NOW^XLFDT
80 . S GMTSDT=$$FMADD^XLFDT(GMTSDT,,,1,)
81 . S $P(^GMT(142.5,+GMTS,0),"^",19)=GMTSDT
82 Q
83TRIM(X) ; Trim Spaces
84 S X=$G(X) F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
85 F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
86 Q X
87B(X) ; Default "B"
88 Q:+($G(DUZ))=0 "" N Y,DIR,DIC,DTOUT,DUOUT,DIROUT,DLAYGO,DA,D,D0,D1,DI,DQ S U="^"
89 S DIC=142.5,DIC(0)="Z",X=" " D ^DIC S X=$S(+Y>0:Y,1:"") Q X
90 Q
91NAH ; Name Help
92 W !," Enter the name of the Health Summary Object, 3 to 30 characters"
93 W !," in length. This Object is stored and then embedded in another"
94 W !," document as needed."
95 Q
96DIM(X) ; Test DIC("S")
97 S X=$G(X) D ^DIM Q:'$D(X) ""
98 Q X
Note: See TracBrowser for help on using the repository browser.