source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG1010P0.m@ 619

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1DG1010P0 ;ALB/REW - VA FORM 10-10 UTILITIES ;29 MAY 92
2 ;;5.3;Registration;;Aug 13, 1993
3UNK(X,NA,BL) ;Returns a value depending on the FIRST true condition:
4 ; NA = 1 : 'NOT APPLICABLE'
5 ; X NOT NULL: X
6 ; BL = 1 : NULL VALUE
7 ; ELSE : 'UNANSWERED'
8 ; INPUT -- X Any value
9 ; NA,BL (Optional) [See above]
10 ; OUTPUT -- [Returned]
11 ; OUTPUT[Set] -- DGUNK =1 if NA=1 or X=""
12 S DGUNK=$S($G(NA):1,(X]""):0,1:1)
13 Q $S(($G(NA)):"NOT APPLICABLE",(X]""):X,($G(BL)):"",1:"UNANSWERED")
14DISP(N,P,NA,BL) ;
15 ; Returns the Pth '^' piece of 'N'
16 ; Output is modified by NA & BL as per $$UNK[see above]
17 ; INPUT: N -- Contents of a node
18 ; P -- the Pth '^' piece
19 ; NA,BL -- Optional output modifiers
20 ; OUTPUT[Returned] -- X
21 ; OUTPUT[Set] -- DGUNK =1 if NA=1 or X=""
22 NEW X
23 S X=$P($G(N),"^",P)
24 S DGUNK=$S($G(NA):1,(X]""):0,1:1)
25 Q $S(($G(NA)):"NOT APPLICABLE",(X]""):X,($G(BL)):"",1:"UNANSWERED")
26POINT(N,P,ROOT,P2,NA,BL) ;
27 ; Returns the external value of a pointer.
28 ; Output is modified by NA & BL as per $$UNK[see above]
29 ; INPUT:
30 ; N -- Contents of a node
31 ; P -- the Pth '^' piece that holds the pointer
32 ; ROOT -- The global root or filenumber if root is ^DIC(ROOT,
33 ; P2 -- The piece of the pointed-to file [Default=1]
34 ; NA,BL-- Optional output modifiers
35 ; OUTPUT[Returned] -- X
36 ; OUTPUT[Set] -- DGUNK =1 if NA=1 or (X or N)=""
37 NEW X,F
38 ; F -- VALUE OF FIELD
39 S:('$G(P2)) P2=1
40 S F=$P(N,"^",P)
41 S:+ROOT X=$P($G(^DIC(ROOT,+F,0)),U,P2)
42 S:(+ROOT=0) X=$P($G(@(ROOT_+F_",0)")),U,P2)
43 S DGUNK=$S($G(NA):1,(X]""):0,1:1)
44 Q $S(($G(NA)):"NOT APPLICABLE",(X]""):X,(F]""):"INVALID",($G(BL)):"",1:"UNANSWERED")
45DATENP(N,P,NA,BL) ;
46 ; Returns External Value of Date in the Pth '^' piece of 'N'
47 ; Output is modified by NA & BL as per $$UNK[see above]
48 ; INPUT:
49 ; N -- Contents of a node
50 ; P -- the Pth '^' piece
51 ; NA,BL -- Optional output modifiers
52 ; OUTPUT[Returned] -- X
53 ; OUTPUT[Set] -- DGUNK =1 if NA=1 or X=""
54 N Y
55 S Y=$$DISP(N,P,+$G(NA),$G(BL))
56 I DGUNK G QDNP
57 X ^DD("DD")
58QDNP ;
59 Q Y
60YN2(N,P) ;
61 ; Ext Val of YES/NO given node & piece.
62 ;IN: N -- Val of Node
63 ; P -- Piece
64 ;OUT:[RETURN] -- Ext Val
65 S X=$P(N,"^",P)
66 Q $S((X="Y"):"YES",(X="N"):"NO",(X="U"):"UNKNOWN",(X=""):"UNANSWERED",("0"[X):"NO",("12"[X):"YES",("3"[X):"UNKNOWN",1:"INVALID")
Note: See TracBrowser for help on using the repository browser.