DG1010P0.m

DG1010P0 ;ALB/REW - VA FORM 10-10 UTILITIES ;29 MAY 92

 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

UNK(X,NA,BL) ;Returns a value depending on the FIRST true condition:

 ; NA = 1    : 'NOT APPLICABLE' 

 ; X NOT NULL: X

 ; BL = 1    : NULL VALUE

 ; ELSE      : 'UNANSWERED'

 ;   INPUT -- X    Any value

 ;            NA,BL (Optional) [See above]

 ;   OUTPUT      -- [Returned]

 ;   OUTPUT[Set] -- DGUNK =1 if NA=1 or X=""

 S DGUNK=$S($G(NA):1,(X]""):0,1:1)

 Q $S(($G(NA)):"NOT APPLICABLE",(X]""):X,($G(BL)):"",1:"UNANSWERED")

DISP(N,P,NA,BL) ;

 ; Returns  the Pth '^' piece of 'N'

 ; Output is modified by NA & BL as per $$UNK[see above]

 ;   INPUT: N -- Contents of a node

 ;     P -- the Pth '^' piece

 ;     NA,BL -- Optional output modifiers

 ;   OUTPUT[Returned] --  X

 ;   OUTPUT[Set]       -- DGUNK =1 if NA=1 or X=""

 NEW X

 S X=$P($G(N),"^",P)

 S DGUNK=$S($G(NA):1,(X]""):0,1:1)

 Q $S(($G(NA)):"NOT APPLICABLE",(X]""):X,($G(BL)):"",1:"UNANSWERED")

POINT(N,P,ROOT,P2,NA,BL) ;

 ; Returns the external value of a pointer.

 ; Output is modified by NA & BL as per $$UNK[see above]

 ; INPUT: 

 ; N    -- Contents of a node

 ; P    -- the Pth '^' piece that holds the pointer

 ; ROOT -- The global root or filenumber if root is ^DIC(ROOT,

 ; P2   -- The piece of the pointed-to file [Default=1]

 ; NA,BL-- Optional output modifiers

 ;   OUTPUT[Returned] --  X

 ;   OUTPUT[Set]      -- DGUNK =1 if NA=1 or (X or N)=""

 NEW X,F

 ; F    -- VALUE OF FIELD

 S:('$G(P2)) P2=1

 S F=$P(N,"^",P)

 S:+ROOT X=$P($G(^DIC(ROOT,+F,0)),U,P2)

 S:(+ROOT=0) X=$P($G(@(ROOT_+F_",0)")),U,P2)

 S DGUNK=$S($G(NA):1,(X]""):0,1:1)

 Q $S(($G(NA)):"NOT APPLICABLE",(X]""):X,(F]""):"INVALID",($G(BL)):"",1:"UNANSWERED")

DATENP(N,P,NA,BL) ;

 ; Returns External Value of Date in the Pth '^' piece of 'N'

 ; Output is modified by NA & BL as per $$UNK[see above]

 ; INPUT: 

 ; N     -- Contents of a node

 ; P     -- the Pth '^' piece

 ; NA,BL -- Optional output modifiers

 ; OUTPUT[Returned] --  X

 ; OUTPUT[Set]      -- DGUNK =1 if NA=1 or X=""

 N Y

 S Y=$$DISP(N,P,+$G(NA),$G(BL))

 I DGUNK G QDNP

 X ^DD("DD")

QDNP ;

 Q Y

YN2(N,P) ;

 ; Ext Val of YES/NO given node & piece.

 ;IN:  N  -- Val of Node

 ;     P  -- Piece

 ;OUT:[RETURN] -- Ext Val 

 S X=$P(N,"^",P)

 Q $S((X="Y"):"YES",(X="N"):"NO",(X="U"):"UNKNOWN",(X=""):"UNANSWERED",("0"[X):"NO",("12"[X):"YES",("3"[X):"UNKNOWN",1:"INVALID")

DG1010P0  ;ALB/REW - VA FORM 10-10 UTILITIES ;29 MAY 92

 +1       ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

UNK(X,NA,BL) ;Returns a value depending on the FIRST true condition:

 +1       ; NA = 1    : 'NOT APPLICABLE' 

 +2       ; X NOT NULL: X

 +3       ; BL = 1    : NULL VALUE

 +4       ; ELSE      : 'UNANSWERED'

 +5       ;   INPUT -- X    Any value

 +6       ;            NA,BL (Optional) [See above]

 +7       ;   OUTPUT      -- [Returned]

 +8       ;   OUTPUT[Set] -- DGUNK =1 if NA=1 or X=""

 +9        SET DGUNK=$SELECT($GET(NA):1,(X]""):0,1:1)

 +10       QUIT $SELECT(($GET(NA)):"NOT APPLICABLE",(X]""):X,($GET(BL)):"",1:"UNANSWERED")

DISP(N,P,NA,BL) ;

 +1       ; Returns  the Pth '^' piece of 'N'

 +2       ; Output is modified by NA & BL as per $$UNK[see above]

 +3       ;   INPUT: N -- Contents of a node

 +4       ;     P -- the Pth '^' piece

 +5       ;     NA,BL -- Optional output modifiers

 +6       ;   OUTPUT[Returned] --  X

 +7       ;   OUTPUT[Set]       -- DGUNK =1 if NA=1 or X=""

 +8        NEW X

 +9        SET X=$PIECE($GET(N),"^",P)

 +10       SET DGUNK=$SELECT($GET(NA):1,(X]""):0,1:1)

 +11       QUIT $SELECT(($GET(NA)):"NOT APPLICABLE",(X]""):X,($GET(BL)):"",1:"UNANSWERED")

POINT(N,P,ROOT,P2,NA,BL) ;

 +1       ; Returns the external value of a pointer.

 +2       ; Output is modified by NA & BL as per $$UNK[see above]

 +3       ; INPUT: 

 +4       ; N    -- Contents of a node

 +5       ; P    -- the Pth '^' piece that holds the pointer

 +6       ; ROOT -- The global root or filenumber if root is ^DIC(ROOT,

 +7       ; P2   -- The piece of the pointed-to file [Default=1]

 +8       ; NA,BL-- Optional output modifiers

 +9       ;   OUTPUT[Returned] --  X

 +10      ;   OUTPUT[Set]      -- DGUNK =1 if NA=1 or (X or N)=""

 +11       NEW X,F

 +12      ; F    -- VALUE OF FIELD

 +13       IF ('$GET(P2))

               SET P2=1

 +14       SET F=$PIECE(N,"^",P)

 +15       IF +ROOT

               SET X=$PIECE($GET(^DIC(ROOT,+F,0)),U,P2)

 +16       IF (+ROOT=0)

               SET X=$PIECE($GET(@(ROOT_+F_",0)")),U,P2)

 +17       SET DGUNK=$SELECT($GET(NA):1,(X]""):0,1:1)

 +18       QUIT $SELECT(($GET(NA)):"NOT APPLICABLE",(X]""):X,(F]""):"INVALID",($GET(BL)):"",1:"UNANSWERED")

DATENP(N,P,NA,BL) ;

 +1       ; Returns External Value of Date in the Pth '^' piece of 'N'

 +2       ; Output is modified by NA & BL as per $$UNK[see above]

 +3       ; INPUT: 

 +4       ; N     -- Contents of a node

 +5       ; P     -- the Pth '^' piece

 +6       ; NA,BL -- Optional output modifiers

 +7       ; OUTPUT[Returned] --  X

 +8       ; OUTPUT[Set]      -- DGUNK =1 if NA=1 or X=""

 +9        NEW Y

 +10       SET Y=$$DISP(N,P,+$GET(NA),$GET(BL))

 +11       IF DGUNK

               GOTO QDNP

 +12       XECUTE ^DD("DD")

QDNP      ;

 +1        QUIT Y

YN2(N,P)  ;

 +1       ; Ext Val of YES/NO given node & piece.

 +2       ;IN:  N  -- Val of Node

 +3       ;     P  -- Piece

 +4       ;OUT:[RETURN] -- Ext Val 

 +5        SET X=$PIECE(N,"^",P)

 +6        QUIT $SELECT((X="Y"):"YES",(X="N"):"NO",(X="U"):"UNKNOWN",(X=""):"UNANSWERED",("0"[X):"NO",("12"[X):"YES",("3"[X):"UNKNOWN",1:"INVALID")