- 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 Apr 23, 2025@18:39:38 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 ;
