DG1010P0 ;ALB/REW - VA FORM 10-10 UTILITIES ;29 MAY 92
;;5.3;Registration;;Aug 13, 1993
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")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG1010P0 2420 printed Dec 13, 2024@02:35:07 Page 2
DG1010P0 ;ALB/REW - VA FORM 10-10 UTILITIES ;29 MAY 92
+1 ;;5.3;Registration;;Aug 13, 1993
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")
