VAQDIS20 ;ALB/JFP - Function Calls for Display;03FEB93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
;
FUNCT ; *************** Function Calls ***************
;
CENTER(LINE,CTR) ; -- Centers text on 80 column screen
; INPUT : line - line to center in
; : ctr - text to center
; OUTPUT : X - centered text
Q:('$D(LINE)) ""
Q:('$D(CTR)) ""
N LEN,LNST
S LEN=$L(CTR)
S LNST=((80-LEN)\2)+1
S X=$$INSERT^VAQUTL1(CTR,LINE,LNST,LEN)
Q X
;
STATE(STATE) ; -- Converts state to abrev
; INPUT : state - long state
; OUTPUT : stavb - abrev state
Q:('$D(STATE)) ""
Q:STATE="" ""
N SDA,STABV
S SDA="",SDA=$O(^DIC(5,"B",STATE,SDA))
S STABV=$S(SDA'="":$P(^DIC(5,SDA,0),U,2),1:" ")
Q STABV
;
COUNTY(STATE,CNTYPT) ; -- Converts county pointer to apha, if passed
; INPUT : state - long state
; : cntypt - county pointer OR text
; OUTPUT : county - county name
Q:('$D(STATE)) ""
Q:('$D(CNTYPT)) ""
Q:(CNTYPT'?1N.N) CNTYPT
Q:STATE="" ""
Q:CNTYPT="" ""
N SDA,CDA,STAVB,COUNTY
S (SDA,CDA)=""
S SDA=$O(^DIC(5,"B",STATE,SDA))
Q:SDA="" ""
S CDA=$O(^DIC(5,SDA,1,"C",CNTYPT,CDA))
S COUNTY=$S(CDA'="":$P(^DIC(5,SDA,1,CDA,0),U,1),1:" ")
Q COUNTY
QUIT
;
BLANK ; -- Sets up blank line
S X=$$SETSTR^VALM1(" ","",1,80) D TMP ; -- null line
QUIT
;
TMP ; -- Sets up display array
S VALMCNT=VALMCNT+1
S @ROOT@(VALMCNT,0)=$E(X,1,79)
QUIT
;
ROOT(ROOT) ; -- Sets root to display
I ROOT["()" S TMP=$P(ROOT,")",1),ROOT=TMP_$C(34)_"DISPLAY"_$C(34)_")" K TMP QUIT ROOT
I ROOT[")" S TMP=$P(ROOT,")",1),ROOT=TMP_","_$C(34)_"DISPLAY"_$C(34)_")" K TMP QUIT ROOT
I ROOT'[")" S ROOT=ROOT_"("_$C(34)_"DISPLAY"_$C(34)_")" QUIT ROOT
QUIT ROOT
;
END ; -- End of code
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQDIS20 1861 printed Oct 16, 2024@18:26:06 Page 2
VAQDIS20 ;ALB/JFP - Function Calls for Display;03FEB93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
+2 ;
FUNCT ; *************** Function Calls ***************
+1 ;
CENTER(LINE,CTR) ; -- Centers text on 80 column screen
+1 ; INPUT : line - line to center in
+2 ; : ctr - text to center
+3 ; OUTPUT : X - centered text
+4 if ('$DATA(LINE))
QUIT ""
+5 if ('$DATA(CTR))
QUIT ""
+6 NEW LEN,LNST
+7 SET LEN=$LENGTH(CTR)
+8 SET LNST=((80-LEN)\2)+1
+9 SET X=$$INSERT^VAQUTL1(CTR,LINE,LNST,LEN)
+10 QUIT X
+11 ;
STATE(STATE) ; -- Converts state to abrev
+1 ; INPUT : state - long state
+2 ; OUTPUT : stavb - abrev state
+3 if ('$DATA(STATE))
QUIT ""
+4 if STATE=""
QUIT ""
+5 NEW SDA,STABV
+6 SET SDA=""
SET SDA=$ORDER(^DIC(5,"B",STATE,SDA))
+7 SET STABV=$SELECT(SDA'="":$PIECE(^DIC(5,SDA,0),U,2),1:" ")
+8 QUIT STABV
+9 ;
COUNTY(STATE,CNTYPT) ; -- Converts county pointer to apha, if passed
+1 ; INPUT : state - long state
+2 ; : cntypt - county pointer OR text
+3 ; OUTPUT : county - county name
+4 if ('$DATA(STATE))
QUIT ""
+5 if ('$DATA(CNTYPT))
QUIT ""
+6 if (CNTYPT'?1N.N)
QUIT CNTYPT
+7 if STATE=""
QUIT ""
+8 if CNTYPT=""
QUIT ""
+9 NEW SDA,CDA,STAVB,COUNTY
+10 SET (SDA,CDA)=""
+11 SET SDA=$ORDER(^DIC(5,"B",STATE,SDA))
+12 if SDA=""
QUIT ""
+13 SET CDA=$ORDER(^DIC(5,SDA,1,"C",CNTYPT,CDA))
+14 SET COUNTY=$SELECT(CDA'="":$PIECE(^DIC(5,SDA,1,CDA,0),U,1),1:" ")
+15 QUIT COUNTY
+16 QUIT
+17 ;
BLANK ; -- Sets up blank line
+1 ; -- null line
SET X=$$SETSTR^VALM1(" ","",1,80)
DO TMP
+2 QUIT
+3 ;
TMP ; -- Sets up display array
+1 SET VALMCNT=VALMCNT+1
+2 SET @ROOT@(VALMCNT,0)=$EXTRACT(X,1,79)
+3 QUIT
+4 ;
ROOT(ROOT) ; -- Sets root to display
+1 IF ROOT["()"
SET TMP=$PIECE(ROOT,")",1)
SET ROOT=TMP_$CHAR(34)_"DISPLAY"_$CHAR(34)_")"
KILL TMP
QUIT ROOT
+2 IF ROOT[")"
SET TMP=$PIECE(ROOT,")",1)
SET ROOT=TMP_","_$CHAR(34)_"DISPLAY"_$CHAR(34)_")"
KILL TMP
QUIT ROOT
+3 IF ROOT'[")"
SET ROOT=ROOT_"("_$CHAR(34)_"DISPLAY"_$CHAR(34)_")"
QUIT ROOT
+4 QUIT ROOT
+5 ;
END ; -- End of code
+1 QUIT
