VAQDIS30 ;ALB/JFP,JRP - BUILDS DISPLAY ARRAY FOR (MAS DATA);3JUL91 [ 10/02/96 10:02 AM ]
;;1.5;PATIENT DATA EXCHANGE;**13,22,40**;NOV 17, 1993
SCR6 ;SCREEN 6 (SECOND HALF)
R9 ;
S X=$$SETSTR^VALM1("A/O EXP: "_$G(@XTRCT@("VALUE",2,.32102,0)),"",9,16)
S VAQTMP=$G(@XTRCT@("VALUE",2,.32107,0)) D SCR6A
S X=$$SETSTR^VALM1("Reg: "_VAQINF,X,26,21)
S VAQTMP=$G(@XTRCT@("VALUE",2,.32109,0)) D SCR6A
S X=$$SETSTR^VALM1("Exam: "_VAQINF,X,44,17)
S X=$$SETSTR^VALM1("A/O #: "_$G(@XTRCT@("VALUE",2,.3211,0)),X,61,17)
D TMP
R10 ;
S X=$$SETSTR^VALM1("ION Rad: "_$G(@XTRCT@("VALUE",2,.32103,0)),"",9,17)
S VAQTMP=$G(@XTRCT@("VALUE",2,.32111,0)) D SCR6A
S X=$$SETSTR^VALM1("Reg: "_VAQINF,X,26,16)
S X=$$SETSTR^VALM1("Method: "_$G(@XTRCT@("VALUE",2,.3212,0)),X,42,37)
D TMP
R11 ;
S X=$$SETSTR^VALM1("Lebanon: "_$G(@XTRCT@("VALUE",2,.3221,0)),"",9,16)
S VAQTMP=$G(@XTRCT@("VALUE",2,.3222,0)) D SCR6A
S X=$$SETSTR^VALM1("From: "_VAQINF,X,25,21)
S VAQTMP=$G(@XTRCT@("VALUE",2,.3223,0)) D SCR6A
S X=$$SETSTR^VALM1("To: "_VAQINF,X,46,33)
D TMP
R12 ;
S X=$$SETSTR^VALM1("Grenada: "_$G(@XTRCT@("VALUE",2,.3224,0)),"",9,16)
S VAQTMP=$G(@XTRCT@("VALUE",2,.3225,0)) D SCR6A
S X=$$SETSTR^VALM1("From: "_VAQINF,X,25,21)
S VAQTMP=$G(@XTRCT@("VALUE",2,.3226,0)) D SCR6A
S X=$$SETSTR^VALM1("To: "_VAQINF,X,46,33)
D TMP
R13 ;
S X=$$SETSTR^VALM1("Panama: "_$G(@XTRCT@("VALUE",2,.3227,0)),"",10,15)
S VAQTMP=$G(@XTRCT@("VALUE",2,.3228,0)) D SCR6A
S X=$$SETSTR^VALM1("From: "_VAQINF,X,25,21)
S VAQTMP=$G(@XTRCT@("VALUE",2,.3229,0)) D SCR6A
S X=$$SETSTR^VALM1("To: "_VAQINF,X,46,33)
D TMP
R14 ;
S X=$$SETSTR^VALM1("Gulf War: "_$G(@XTRCT@("VALUE",2,.32201,0)),"",8,17)
S VAQTMP=$G(@XTRCT@("VALUE",2,.322011,0)) D SCR6A
S X=$$SETSTR^VALM1("From: "_VAQINF,X,25,21)
S VAQTMP=$G(@XTRCT@("VALUE",2,.322012,0)) D SCR6A
S X=$$SETSTR^VALM1("To: "_VAQINF,X,46,33)
D TMP
R15 ;
S X=$$SETSTR^VALM1("Somalia: "_$G(@XTRCT@("VALUE",2,.322016,0)),"",9,16)
S VAQTMP=$G(@XTRCT@("VALUE",2,.322017,0)) D SCR6A
S X=$$SETSTR^VALM1("From: "_VAQINF,X,25,21)
S VAQTMP=$G(@XTRCT@("VALUE",2,.322018,0)) D SCR6A
S X=$$SETSTR^VALM1("To: "_VAQINF,X,46,33)
D TMP
R16 ;
S X=$$SETSTR^VALM1("Env Contam: "_$G(@XTRCT@("VALUE",2,.322013,0)),"",6,20)
S VAQTMP=$G(@XTRCT@("VALUE",2,.322014,0)) D SCR6A
S X=$$SETSTR^VALM1("Reg: "_VAQINF,X,26,18)
S VAQTMP=$G(@XTRCT@("VALUE",2,.322015,0)) D SCR6A
S X=$$SETSTR^VALM1("Exam: "_VAQINF,X,44,35)
D TMP
R17 ;
S X=$$SETSTR^VALM1("Mil Disab: "_$G(@XTRCT@("VALUE",2,.362,0)),"",7,72)
D TMP
R18 ;
;D BLANK^VAQDIS20
S X=$$SETSTR^VALM1("Dent Inj: "_$G(@XTRCT@("VALUE",2,.368,0)),"",8,44)
S VAQTMP=$G(@XTRCT@("VALUE",2,.369,0))
S VAQINF=$S(VAQTMP'="":VAQTMP,1:"UNANSWERED")
S X=$$SETSTR^VALM1("Teeth Extracted: "_VAQINF,X,52,27)
D TMP
R19 ;
;DISPLAY DENTAL TREATMENT FROM LEAST RECENT TO MOST RECENT
S X=""
F S X=$O(@XTRCT@("VALUE",2.11,.01,X)) Q:(X="") D
.S VAQTMP=@XTRCT@("VALUE",2.11,.01,X)
.;Check when no dental treatment dates exist
.Q:(VAQTMP="")
.D SCR6A
.S VAQCHK(VAQTMP)=VAQINF_"^"_$G(@XTRCT@("VALUE",2.11,2,X))
S VAQCHK=""
F S VAQCHK=$O(VAQCHK(VAQCHK)) Q:(VAQCHK="") D
.S VAQTMP=VAQCHK(VAQCHK)
.S X=" Trt Date: "_$P(VAQTMP,"^",1)
.S X=$$SETSTR^VALM1("Cond.:",X,24,6)
.S VAQINF=$P(VAQTMP,"^",2)
.S VAQINF(1)=""
.F VAQTMP=1:1:$L(VAQINF," ") D
..S VAQINF(2)=" "_$P(VAQINF," ",VAQTMP)
..I ($L(VAQINF(2))>49) D
...S $P(VAQINF," ",VAQTMP)=$E(VAQINF(2),50,$L(VAQINF(2)))
...S VAQINF(2)=$E(VAQINF(2),1,49)
...S VAQTMP=VAQTMP-1
..I (($L(VAQINF(1))+$L(VAQINF(2)))>49) D
...S X=$$SETSTR^VALM1(VAQINF(1),X,30,49)
...D TMP
...S (VAQINF(1),X)=""
..S VAQINF(1)=VAQINF(1)_VAQINF(2)
.I (VAQINF(1)'="") D
..S X=$$SETSTR^VALM1(VAQINF(1),X,30,49)
..D TMP
K VAQCHK
R20 ;
S X=$$SETSTR^VALM1("Yugoslavia: "_$G(@XTRCT@("VALUE",2,.322019,0)),"",6,19)
S VAQTMP=$G(@XTRCT@("VALUE",2,.32202,0)) D SCR6A
S X=$$SETSTR^VALM1("From: "_VAQINF,X,25,21)
S VAQTMP=$G(@XTRCT@("VALUE",2,.322021,0)) D SCR6A
S X=$$SETSTR^VALM1("To: "_VAQINF,X,46,33)
D TMP
R21 ;
S VAQTMP=$G(@XTRCT@("VALUE",2,.531,0))
S X=$$SETSTR^VALM1("Purple Heart: "_VAQTMP,"",4,27)
I $E(VAQTMP)="Y" D
. S VAQTMP=$G(@XTRCT@("VALUE",2,.532,0)) Q:VAQTMP']""
. S X=$$SETSTR^VALM1("PH Status: "_VAQTMP,X,31,48)
E I $E(VAQTMP)="N" D
. S VAQTMP=$G(@XTRCT@("VALUE",2,.533,0)) Q:VAQTMP']""
. S X=$$SETSTR^VALM1("PH Remarks: "_VAQTMP,X,31,48)
D TMP
EXIT K VAQTMP,VAQINF
QUIT
;
TMP ; -- Sets up display array
S VALMCNT=VALMCNT+1
S @ROOT@(VALMCNT,0)=$E(X,1,79)
QUIT
;
SCR6A ; -- External date to internal date
I VAQTMP="" S VAQINF="" QUIT
S VAQTMP=$$DATE^VAQUTL99(VAQTMP)
S VAQINF=$S(VAQTMP'="":$E(VAQTMP,4,5)_"/"_$E(VAQTMP,6,7)_"/"_$E(VAQTMP,2,3),1:VAQTMP)
QUIT
;
SCR6B I VAQINF["OTHER THAN" S VAQINF="OTHER"
S VAQINF=$E(VAQINF,1,12)
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQDIS30 4884 printed Apr 09, 2024@21:27:29 Page 2
VAQDIS30 ;ALB/JFP,JRP - BUILDS DISPLAY ARRAY FOR (MAS DATA);3JUL91 [ 10/02/96 10:02 AM ]
+1 ;;1.5;PATIENT DATA EXCHANGE;**13,22,40**;NOV 17, 1993
SCR6 ;SCREEN 6 (SECOND HALF)
R9 ;
+1 SET X=$$SETSTR^VALM1("A/O EXP: "_$GET(@XTRCT@("VALUE",2,.32102,0)),"",9,16)
+2 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.32107,0))
DO SCR6A
+3 SET X=$$SETSTR^VALM1("Reg: "_VAQINF,X,26,21)
+4 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.32109,0))
DO SCR6A
+5 SET X=$$SETSTR^VALM1("Exam: "_VAQINF,X,44,17)
+6 SET X=$$SETSTR^VALM1("A/O #: "_$GET(@XTRCT@("VALUE",2,.3211,0)),X,61,17)
+7 DO TMP
R10 ;
+1 SET X=$$SETSTR^VALM1("ION Rad: "_$GET(@XTRCT@("VALUE",2,.32103,0)),"",9,17)
+2 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.32111,0))
DO SCR6A
+3 SET X=$$SETSTR^VALM1("Reg: "_VAQINF,X,26,16)
+4 SET X=$$SETSTR^VALM1("Method: "_$GET(@XTRCT@("VALUE",2,.3212,0)),X,42,37)
+5 DO TMP
R11 ;
+1 SET X=$$SETSTR^VALM1("Lebanon: "_$GET(@XTRCT@("VALUE",2,.3221,0)),"",9,16)
+2 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.3222,0))
DO SCR6A
+3 SET X=$$SETSTR^VALM1("From: "_VAQINF,X,25,21)
+4 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.3223,0))
DO SCR6A
+5 SET X=$$SETSTR^VALM1("To: "_VAQINF,X,46,33)
+6 DO TMP
R12 ;
+1 SET X=$$SETSTR^VALM1("Grenada: "_$GET(@XTRCT@("VALUE",2,.3224,0)),"",9,16)
+2 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.3225,0))
DO SCR6A
+3 SET X=$$SETSTR^VALM1("From: "_VAQINF,X,25,21)
+4 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.3226,0))
DO SCR6A
+5 SET X=$$SETSTR^VALM1("To: "_VAQINF,X,46,33)
+6 DO TMP
R13 ;
+1 SET X=$$SETSTR^VALM1("Panama: "_$GET(@XTRCT@("VALUE",2,.3227,0)),"",10,15)
+2 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.3228,0))
DO SCR6A
+3 SET X=$$SETSTR^VALM1("From: "_VAQINF,X,25,21)
+4 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.3229,0))
DO SCR6A
+5 SET X=$$SETSTR^VALM1("To: "_VAQINF,X,46,33)
+6 DO TMP
R14 ;
+1 SET X=$$SETSTR^VALM1("Gulf War: "_$GET(@XTRCT@("VALUE",2,.32201,0)),"",8,17)
+2 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.322011,0))
DO SCR6A
+3 SET X=$$SETSTR^VALM1("From: "_VAQINF,X,25,21)
+4 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.322012,0))
DO SCR6A
+5 SET X=$$SETSTR^VALM1("To: "_VAQINF,X,46,33)
+6 DO TMP
R15 ;
+1 SET X=$$SETSTR^VALM1("Somalia: "_$GET(@XTRCT@("VALUE",2,.322016,0)),"",9,16)
+2 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.322017,0))
DO SCR6A
+3 SET X=$$SETSTR^VALM1("From: "_VAQINF,X,25,21)
+4 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.322018,0))
DO SCR6A
+5 SET X=$$SETSTR^VALM1("To: "_VAQINF,X,46,33)
+6 DO TMP
R16 ;
+1 SET X=$$SETSTR^VALM1("Env Contam: "_$GET(@XTRCT@("VALUE",2,.322013,0)),"",6,20)
+2 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.322014,0))
DO SCR6A
+3 SET X=$$SETSTR^VALM1("Reg: "_VAQINF,X,26,18)
+4 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.322015,0))
DO SCR6A
+5 SET X=$$SETSTR^VALM1("Exam: "_VAQINF,X,44,35)
+6 DO TMP
R17 ;
+1 SET X=$$SETSTR^VALM1("Mil Disab: "_$GET(@XTRCT@("VALUE",2,.362,0)),"",7,72)
+2 DO TMP
R18 ;
+1 ;D BLANK^VAQDIS20
+2 SET X=$$SETSTR^VALM1("Dent Inj: "_$GET(@XTRCT@("VALUE",2,.368,0)),"",8,44)
+3 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.369,0))
+4 SET VAQINF=$SELECT(VAQTMP'="":VAQTMP,1:"UNANSWERED")
+5 SET X=$$SETSTR^VALM1("Teeth Extracted: "_VAQINF,X,52,27)
+6 DO TMP
R19 ;
+1 ;DISPLAY DENTAL TREATMENT FROM LEAST RECENT TO MOST RECENT
+2 SET X=""
+3 FOR
SET X=$ORDER(@XTRCT@("VALUE",2.11,.01,X))
if (X="")
QUIT
Begin DoDot:1
+4 SET VAQTMP=@XTRCT@("VALUE",2.11,.01,X)
+5 ;Check when no dental treatment dates exist
+6 if (VAQTMP="")
QUIT
+7 DO SCR6A
+8 SET VAQCHK(VAQTMP)=VAQINF_"^"_$GET(@XTRCT@("VALUE",2.11,2,X))
End DoDot:1
+9 SET VAQCHK=""
+10 FOR
SET VAQCHK=$ORDER(VAQCHK(VAQCHK))
if (VAQCHK="")
QUIT
Begin DoDot:1
+11 SET VAQTMP=VAQCHK(VAQCHK)
+12 SET X=" Trt Date: "_$PIECE(VAQTMP,"^",1)
+13 SET X=$$SETSTR^VALM1("Cond.:",X,24,6)
+14 SET VAQINF=$PIECE(VAQTMP,"^",2)
+15 SET VAQINF(1)=""
+16 FOR VAQTMP=1:1:$LENGTH(VAQINF," ")
Begin DoDot:2
+17 SET VAQINF(2)=" "_$PIECE(VAQINF," ",VAQTMP)
+18 IF ($LENGTH(VAQINF(2))>49)
Begin DoDot:3
+19 SET $PIECE(VAQINF," ",VAQTMP)=$EXTRACT(VAQINF(2),50,$LENGTH(VAQINF(2)))
+20 SET VAQINF(2)=$EXTRACT(VAQINF(2),1,49)
+21 SET VAQTMP=VAQTMP-1
End DoDot:3
+22 IF (($LENGTH(VAQINF(1))+$LENGTH(VAQINF(2)))>49)
Begin DoDot:3
+23 SET X=$$SETSTR^VALM1(VAQINF(1),X,30,49)
+24 DO TMP
+25 SET (VAQINF(1),X)=""
End DoDot:3
+26 SET VAQINF(1)=VAQINF(1)_VAQINF(2)
End DoDot:2
+27 IF (VAQINF(1)'="")
Begin DoDot:2
+28 SET X=$$SETSTR^VALM1(VAQINF(1),X,30,49)
+29 DO TMP
End DoDot:2
End DoDot:1
+30 KILL VAQCHK
R20 ;
+1 SET X=$$SETSTR^VALM1("Yugoslavia: "_$GET(@XTRCT@("VALUE",2,.322019,0)),"",6,19)
+2 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.32202,0))
DO SCR6A
+3 SET X=$$SETSTR^VALM1("From: "_VAQINF,X,25,21)
+4 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.322021,0))
DO SCR6A
+5 SET X=$$SETSTR^VALM1("To: "_VAQINF,X,46,33)
+6 DO TMP
R21 ;
+1 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.531,0))
+2 SET X=$$SETSTR^VALM1("Purple Heart: "_VAQTMP,"",4,27)
+3 IF $EXTRACT(VAQTMP)="Y"
Begin DoDot:1
+4 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.532,0))
if VAQTMP']""
QUIT
+5 SET X=$$SETSTR^VALM1("PH Status: "_VAQTMP,X,31,48)
End DoDot:1
+6 IF '$TEST
IF $EXTRACT(VAQTMP)="N"
Begin DoDot:1
+7 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.533,0))
if VAQTMP']""
QUIT
+8 SET X=$$SETSTR^VALM1("PH Remarks: "_VAQTMP,X,31,48)
End DoDot:1
+9 DO TMP
EXIT KILL VAQTMP,VAQINF
+1 QUIT
+2 ;
TMP ; -- Sets up display array
+1 SET VALMCNT=VALMCNT+1
+2 SET @ROOT@(VALMCNT,0)=$EXTRACT(X,1,79)
+3 QUIT
+4 ;
SCR6A ; -- External date to internal date
+1 IF VAQTMP=""
SET VAQINF=""
QUIT
+2 SET VAQTMP=$$DATE^VAQUTL99(VAQTMP)
+3 SET VAQINF=$SELECT(VAQTMP'="":$EXTRACT(VAQTMP,4,5)_"/"_$EXTRACT(VAQTMP,6,7)_"/"_$EXTRACT(VAQTMP,2,3),1:VAQTMP)
+4 QUIT
+5 ;
SCR6B IF VAQINF["OTHER THAN"
SET VAQINF="OTHER"
+1 SET VAQINF=$EXTRACT(VAQINF,1,12)
+2 QUIT
