VAQDIS42 ;ALB/JRP/JFP - PRINT ACTION PROFILE (CONT);30APR92
;;1.5;PATIENT DATA EXCHANGE;**13**;NOV 17, 1993
DEMOG ;PRINT PHARMACY DEMOGRAPHICS
;CHECK PARAMETERS
N LOOP,X,TMP,TMP1,TMP2,ADDRESS,FLAG
;
R1 S X=$$SETSTR^VALM1($G(@XTRCT@("VALUE",2,.01,0)),"",1,40)
S X=$$SETSTR^VALM1("SSN: "_$G(@XTRCT@("VALUE",2,.09,0)),X,42,37)
D TMP^VAQDIS20
; -- SET UP ADDRESS ARRAY
S X=1
F LOOP=.111,.112,.113 D
.S VAQTMP=$G(@XTRCT@("VALUE",2,LOOP,0))
.I VAQTMP'="" S ADDRESS(X)=VAQTMP,X=X+1
S ADDRESS(X)=$G(@XTRCT@("VALUE",2,.114,0))_", "_$G(@XTRCT@("VALUE",2,.115,0))_" "_$G(@XTRCT@("VALUE",2,.1112,0))
K LOOP,VAQTMP,X
R2 ;
S VAQINF=$S($D(ADDRESS(1)):ADDRESS(1),1:"")
S X=$$SETSTR^VALM1(VAQINF,"",1,40)
S X=$$SETSTR^VALM1("DOB: "_$G(@XTRCT@("VALUE",2,.03,0)),X,42,37)
D TMP^VAQDIS20 K VAQINF
R3 ;
S VAQINF=$S($D(ADDRESS(2)):ADDRESS(2),1:"")
S X=$$SETSTR^VALM1(VAQINF,"",1,39)
S X=$$SETSTR^VALM1("Phone: "_$G(@XTRCT@("VALUE",2,.131,0)),X,40,39)
D TMP^VAQDIS20 K VAQINF
R4 ;
S VAQINF=$S($D(ADDRESS(3)):ADDRESS(3),1:"")
S X=$$SETSTR^VALM1(VAQINF,"",1,40)
S X=$$SETSTR^VALM1("Elig: "_$G(@XTRCT@("VALUE",2,.361,0)),X,41,36)
D TMP^VAQDIS20 K VAQINF
R5 ;
I $D(ADDRESS(4)) S X=$$SETSTR^VALM1(ADDRESS(4),"",1,40) D TMP^VAQDIS20
K ADDRESS
D BLANK^VAQDIS20
;
R6 ; -- Print Narrative
S VAQTMP=$G(@XTRCT@("VALUE",55,1,0))
I VAQTMP="" S X=$$SETSTR^VALM1("Pharmacy Narrative: None","",1,79) D TMP^VAQDIS20
I VAQTMP'="" D
.D SETNAR
.S K=""
.F J=0:0 S K=$O(LN($J,K)) Q:K="" D
..S:K=1 X=$$SETSTR^VALM1("Pharmacy Narrative:"_$G(LN($J,K)),"",1,79)
..S:K'=1 X=$$SETSTR^VALM1(" "_$G(LN($J,K)),"",1,79)
..D TMP^VAQDIS20
D BLANK^VAQDIS20
K VAQTMP,VAQLN,VAQWORD,LN,K,J
;
R7 ; -- Print rated disabilities
S SEQ=""
F J=1:1 S SEQ=$O(@XTRCT@("VALUE",2.04,.01,SEQ)) Q:SEQ="" D
.S VAQTMP1=$G(@XTRCT@("VALUE",2.04,.01,SEQ))
.S VAQTMP2=$G(@XTRCT@("VALUE",2.04,2,SEQ))
.S VAQTMP3=$G(@XTRCT@("VALUE",2.04,3,SEQ))
.S VAQTMP4=$S(VAQTMP3="YES":"SC",1:"NSC")
.S VAQINF=VAQTMP1_" ("_VAQTMP2_"%-"_VAQTMP4_")"
.S:J=1 X=$$SETSTR^VALM1("Rated Disabilities: "_VAQINF,"",1,79)
.S:J'=1 X=$$SETSTR^VALM1(" "_VAQINF,"",1,79)
.D TMP^VAQDIS20
I J=1 S X=$$SETSTR^VALM1("Rated Disability: None","",1,79) D TMP^VAQDIS20
D BLANK^VAQDIS20
K VAQTMP1,VAQTMP2,VAQTMP3,VAQTMP4,VAQINF,SEQ,J
;
R8 ; -- PRINT REACTIONS
S (SEQ,VAQLN)=""
F J=1:1 S SEQ=$O(@XTRCT@("VALUE",120.8,.02,SEQ)) Q:SEQ="" D
.S VAQTMP=$G(@XTRCT@("VALUE",120.8,.02,SEQ))
.I ($L(VAQLN_", "_VAQTMP)>68)&(J=1) S X=$$SETSTR^VALM1("Reactions: "_VAQLN,"",1,79) D TMP^VAQDIS20 S VAQLN=""
.I ($L(VAQLN_", "_VAQTMP)>68)&(J'=1) S X=$$SETSTR^VALM1(" "_VAQLN,"",1,79) D TMP^VAQDIS20 S VAQLN=""
.I J=1 S VAQLN=VAQLN_VAQTMP
.I J'=1 S VAQLN=VAQLN_", "_VAQTMP
I VAQLN'="" S X=$$SETSTR^VALM1("Reactions: "_VAQLN,"",1,79) D TMP^VAQDIS20
I VAQLN="" S X=$$SETSTR^VALM1("Reactions: None","",1,79) D TMP^VAQDIS20
K VAQTMP,VAQLN,SEQ,J
D BLANK^VAQDIS20
QUIT
;
SETNAR ; -- Sets display line for narrative
S VAQLN="",K=1
F J=1:1 D Q:VAQWORD=""
.S VAQWORD=$P(VAQTMP," ",J)
.Q:VAQWORD=""
.I ($L(VAQLN_" "_VAQWORD)>59) S LN($J,K)=VAQLN,VAQLN="",K=K+1
.S VAQLN=VAQLN_" "_VAQWORD
I $D(VAQLN) S LN($J,K)=VAQLN
QUIT
;
END ; -- End of Code
QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQDIS42 3335 printed Nov 22, 2024@17:35:40 Page 2
VAQDIS42 ;ALB/JRP/JFP - PRINT ACTION PROFILE (CONT);30APR92
+1 ;;1.5;PATIENT DATA EXCHANGE;**13**;NOV 17, 1993
DEMOG ;PRINT PHARMACY DEMOGRAPHICS
+1 ;CHECK PARAMETERS
+2 NEW LOOP,X,TMP,TMP1,TMP2,ADDRESS,FLAG
+3 ;
R1 SET X=$$SETSTR^VALM1($GET(@XTRCT@("VALUE",2,.01,0)),"",1,40)
+1 SET X=$$SETSTR^VALM1("SSN: "_$GET(@XTRCT@("VALUE",2,.09,0)),X,42,37)
+2 DO TMP^VAQDIS20
+3 ; -- SET UP ADDRESS ARRAY
+4 SET X=1
+5 FOR LOOP=.111,.112,.113
Begin DoDot:1
+6 SET VAQTMP=$GET(@XTRCT@("VALUE",2,LOOP,0))
+7 IF VAQTMP'=""
SET ADDRESS(X)=VAQTMP
SET X=X+1
End DoDot:1
+8 SET ADDRESS(X)=$GET(@XTRCT@("VALUE",2,.114,0))_", "_$GET(@XTRCT@("VALUE",2,.115,0))_" "_$GET(@XTRCT@("VALUE",2,.1112,0))
+9 KILL LOOP,VAQTMP,X
R2 ;
+1 SET VAQINF=$SELECT($DATA(ADDRESS(1)):ADDRESS(1),1:"")
+2 SET X=$$SETSTR^VALM1(VAQINF,"",1,40)
+3 SET X=$$SETSTR^VALM1("DOB: "_$GET(@XTRCT@("VALUE",2,.03,0)),X,42,37)
+4 DO TMP^VAQDIS20
KILL VAQINF
R3 ;
+1 SET VAQINF=$SELECT($DATA(ADDRESS(2)):ADDRESS(2),1:"")
+2 SET X=$$SETSTR^VALM1(VAQINF,"",1,39)
+3 SET X=$$SETSTR^VALM1("Phone: "_$GET(@XTRCT@("VALUE",2,.131,0)),X,40,39)
+4 DO TMP^VAQDIS20
KILL VAQINF
R4 ;
+1 SET VAQINF=$SELECT($DATA(ADDRESS(3)):ADDRESS(3),1:"")
+2 SET X=$$SETSTR^VALM1(VAQINF,"",1,40)
+3 SET X=$$SETSTR^VALM1("Elig: "_$GET(@XTRCT@("VALUE",2,.361,0)),X,41,36)
+4 DO TMP^VAQDIS20
KILL VAQINF
R5 ;
+1 IF $DATA(ADDRESS(4))
SET X=$$SETSTR^VALM1(ADDRESS(4),"",1,40)
DO TMP^VAQDIS20
+2 KILL ADDRESS
+3 DO BLANK^VAQDIS20
+4 ;
R6 ; -- Print Narrative
+1 SET VAQTMP=$GET(@XTRCT@("VALUE",55,1,0))
+2 IF VAQTMP=""
SET X=$$SETSTR^VALM1("Pharmacy Narrative: None","",1,79)
DO TMP^VAQDIS20
+3 IF VAQTMP'=""
Begin DoDot:1
+4 DO SETNAR
+5 SET K=""
+6 FOR J=0:0
SET K=$ORDER(LN($JOB,K))
if K=""
QUIT
Begin DoDot:2
+7 if K=1
SET X=$$SETSTR^VALM1("Pharmacy Narrative:"_$GET(LN($JOB,K)),"",1,79)
+8 if K'=1
SET X=$$SETSTR^VALM1(" "_$GET(LN($JOB,K)),"",1,79)
+9 DO TMP^VAQDIS20
End DoDot:2
End DoDot:1
+10 DO BLANK^VAQDIS20
+11 KILL VAQTMP,VAQLN,VAQWORD,LN,K,J
+12 ;
R7 ; -- Print rated disabilities
+1 SET SEQ=""
+2 FOR J=1:1
SET SEQ=$ORDER(@XTRCT@("VALUE",2.04,.01,SEQ))
if SEQ=""
QUIT
Begin DoDot:1
+3 SET VAQTMP1=$GET(@XTRCT@("VALUE",2.04,.01,SEQ))
+4 SET VAQTMP2=$GET(@XTRCT@("VALUE",2.04,2,SEQ))
+5 SET VAQTMP3=$GET(@XTRCT@("VALUE",2.04,3,SEQ))
+6 SET VAQTMP4=$SELECT(VAQTMP3="YES":"SC",1:"NSC")
+7 SET VAQINF=VAQTMP1_" ("_VAQTMP2_"%-"_VAQTMP4_")"
+8 if J=1
SET X=$$SETSTR^VALM1("Rated Disabilities: "_VAQINF,"",1,79)
+9 if J'=1
SET X=$$SETSTR^VALM1(" "_VAQINF,"",1,79)
+10 DO TMP^VAQDIS20
End DoDot:1
+11 IF J=1
SET X=$$SETSTR^VALM1("Rated Disability: None","",1,79)
DO TMP^VAQDIS20
+12 DO BLANK^VAQDIS20
+13 KILL VAQTMP1,VAQTMP2,VAQTMP3,VAQTMP4,VAQINF,SEQ,J
+14 ;
R8 ; -- PRINT REACTIONS
+1 SET (SEQ,VAQLN)=""
+2 FOR J=1:1
SET SEQ=$ORDER(@XTRCT@("VALUE",120.8,.02,SEQ))
if SEQ=""
QUIT
Begin DoDot:1
+3 SET VAQTMP=$GET(@XTRCT@("VALUE",120.8,.02,SEQ))
+4 IF ($LENGTH(VAQLN_", "_VAQTMP)>68)&(J=1)
SET X=$$SETSTR^VALM1("Reactions: "_VAQLN,"",1,79)
DO TMP^VAQDIS20
SET VAQLN=""
+5 IF ($LENGTH(VAQLN_", "_VAQTMP)>68)&(J'=1)
SET X=$$SETSTR^VALM1(" "_VAQLN,"",1,79)
DO TMP^VAQDIS20
SET VAQLN=""
+6 IF J=1
SET VAQLN=VAQLN_VAQTMP
+7 IF J'=1
SET VAQLN=VAQLN_", "_VAQTMP
End DoDot:1
+8 IF VAQLN'=""
SET X=$$SETSTR^VALM1("Reactions: "_VAQLN,"",1,79)
DO TMP^VAQDIS20
+9 IF VAQLN=""
SET X=$$SETSTR^VALM1("Reactions: None","",1,79)
DO TMP^VAQDIS20
+10 KILL VAQTMP,VAQLN,SEQ,J
+11 DO BLANK^VAQDIS20
+12 QUIT
+13 ;
SETNAR ; -- Sets display line for narrative
+1 SET VAQLN=""
SET K=1
+2 FOR J=1:1
Begin DoDot:1
+3 SET VAQWORD=$PIECE(VAQTMP," ",J)
+4 if VAQWORD=""
QUIT
+5 IF ($LENGTH(VAQLN_" "_VAQWORD)>59)
SET LN($JOB,K)=VAQLN
SET VAQLN=""
SET K=K+1
+6 SET VAQLN=VAQLN_" "_VAQWORD
End DoDot:1
if VAQWORD=""
QUIT
+7 IF $DATA(VAQLN)
SET LN($JOB,K)=VAQLN
+8 QUIT
+9 ;
END ; -- End of Code
+1 QUIT
+2 ;
