VAQDIS43 ;ALB/JRP/JFP - PRINT ACTION PROFILE (CONT);30APR92
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
LONG ;PRINT LONG FORMAT
S VAQPOP=0
D SORT Q:VAQPOP=1
D REFILL
D LSORT
D EXIT
QUIT
;
LSORT S (Z1,Z2)=""
F S Z1=$O(^TMP("VAQSORT",$J,Z1)) Q:Z1="" D LG0
QUIT
LG0 F S Z2=$O(^TMP("VAQSORT",$J,Z1,Z2)) Q:Z2="" D LG1
QUIT
;
LG1 ; -- Line 1
S SEQ=$G(^TMP("VAQSORT",$J,Z1,Z2))
S VAQRXN=$G(@XTRCT@("VALUE",52,.01,SEQ))
S X=$$SETSTR^VALM1("RX #: "_VAQRXN,"",1,79)
D TMP^VAQDIS20
LG2 ;
S X=$$SETSTR^VALM1($G(@XTRCT@("VALUE",52,6,SEQ)),"",1,44)
S X=$$SETSTR^VALM1("SIG: "_$G(@XTRCT@("VALUE",52,10,SEQ)),X,45,34)
D TMP^VAQDIS20
LG3 ;
S X=$$SETSTR^VALM1("QTY: "_$G(@XTRCT@("VALUE",52,7,SEQ)),"",3,21)
S X=$$SETSTR^VALM1("# OF REFILLS: "_$G(@XTRCT@("VALUE",52,9,SEQ)),X,23,22)
S VAQTMP=$$DATE^VAQUTL99($G(@XTRCT@("VALUE",52,1,SEQ)))
S TMP=$$DOBFMT^VAQUTL99(VAQTMP,0)
S:(TMP=-1) TMP=""
S:(TMP'="") $P(TMP,"-",3)=$E($P(TMP,"-",3),3,4)
S VAQTMP=$$DATE^VAQUTL99($G(@XTRCT@("VALUE",52,26,SEQ)))
S TMP1=$$DOBFMT^VAQUTL99(VAQTMP,0)
S:(TMP1=-1) TMP=""
S:(TMP1'="") $P(TMP1,"-",3)=$E($P(TMP1,"-",3),3,4)
S X=$$SETSTR^VALM1("ISSUE/EXPR: "_TMP_" / "_TMP1,X,45,34)
D TMP^VAQDIS20
LG4 ;
S X=$$SETSTR^VALM1("PHYS: "_$G(@XTRCT@("VALUE",52,4,SEQ)),"",3,27)
S X=$$SETSTR^VALM1("CLERK: "_$G(@XTRCT@("VALUE",52,16,SEQ)),X,30,15)
S VAQTMP=$$DATE^VAQUTL99($G(@XTRCT@("VALUE",52,22,SEQ)))
S TMP=$$DOBFMT^VAQUTL99(VAQTMP,0)
S:(TMP=-1) TMP=""
S:(TMP'="") $P(TMP,"-",3)=$E($P(TMP,"-",3),3,4)
S X=$$SETSTR^VALM1("FILL DATE: "_TMP,X,45,34)
D TMP^VAQDIS20
LG5 ;
S VAQTMP=$$DATE^VAQUTL99($G(@XTRCT@("VALUE",52.1,.01,SEQ)))
S TMP=$$DOBFMT^VAQUTL99(VAQTMP,0)
S:(TMP=-1) TMP=""
S:(TMP'="") $P(TMP,"-",3)=$E($P(TMP,"-",3),3,4)
S X=$$SETSTR^VALM1("REFILLED: "_TMP,"",3,79)
D TMP^VAQDIS20
LG6 ;
S X=$$SETSTR^VALM1("REMARKS: "_$G(@XTRCT@("VALUE",52,12,SEQ)),"",3,79)
D TMP^VAQDIS20
LG7 ;
S X=$$SETSTR^VALM1("DIVISION: "_$G(@XTRCT@("VALUE",52,20,SEQ)),"",3,38)
S X=$$SETSTR^VALM1($G(@XTRCT@("VALUE",52,100,SEQ)),X,40,20)
S VAQTMP=$G(@XTRCT@("VALUE",52,9,SEQ))
S VAQRFL=$S($G(VAQRF(VAQRXN))="":0,1:$G(VAQRF(VAQRXN)))
S VAQREM=VAQTMP-VAQRFL
S X=$$SETSTR^VALM1(VAQREM_" REFILL"_$S(VAQREM=1:"",1:"S"),X,60,17)
D TMP^VAQDIS20
D BLANK^VAQDIS20
QUIT
;
SHORT ; -- Print short format
S VAQPOP=0
D SORT Q:VAQPOP=1
D REFILL
D SSORT
D EXIT
QUIT
;
SSORT S (Z1,Z2)=""
F S Z1=$O(^TMP("VAQSORT",$J,Z1)) Q:Z1="" D SH0
QUIT
SH0 F S Z2=$O(^TMP("VAQSORT",$J,Z1,Z2)) Q:Z2="" D SH1
QUIT
;
SH1 ; -- Line 1
S SEQ=$G(^TMP("VAQSORT",$J,Z1,Z2))
S VAQRXN=$G(@XTRCT@("VALUE",52,.01,SEQ))
S X=$$SETSTR^VALM1(VAQRXN,"",1,7)
SH2 ;
S X=$$SETSTR^VALM1($G(@XTRCT@("VALUE",52,6,SEQ)),X,8,37)
SH3 ;
S VAQTMP=$G(@XTRCT@("VALUE",52,100,SEQ))
S X=$$SETSTR^VALM1($E(VAQTMP,1),X,47,2)
SH4 ;
S VAQTMP=$G(@XTRCT@("VALUE",52,7,SEQ))
S VAQINF=$J(VAQTMP,5)
S X=$$SETSTR^VALM1(VAQINF,X,49,5)
SH5 ;
S VAQTMP=$G(@XTRCT@("VALUE",52,1,SEQ))
S VAQTMP=$$DATE^VAQUTL99(VAQTMP)
S TMP=$$DOBFMT^VAQUTL99(VAQTMP,0)
S:(TMP=-1) TMP=""
S:(TMP'="") $P(TMP,"-",3)=$E($P(TMP,"-",3),3,4)
S X=$$SETSTR^VALM1(TMP,X,56,10)
SH6 ;
S VAQTMP=$G(@XTRCT@("VALUE",52,101,SEQ))
S VAQTMP=$$DATE^VAQUTL99(VAQTMP)
S TMP=$$DOBFMT^VAQUTL99(VAQTMP,0)
S:(TMP=-1) TMP=""
S:(TMP'="") $P(TMP,"-",3)=$E($P(TMP,"-",3),3,4)
S X=$$SETSTR^VALM1(TMP,X,66,10)
SH7 ;
S VAQTMP=$G(@XTRCT@("VALUE",52,9,SEQ))
S VAQRFL=$S($G(VAQRF(VAQRXN))="":0,1:$G(VAQRF(VAQRXN)))
S VAQREM=VAQTMP-VAQRFL
S X=$$SETSTR^VALM1("("_VAQREM_")",X,76,3)
D TMP^VAQDIS20
SH20 ; -- Line 2
S X=$$SETSTR^VALM1($G(@XTRCT@("VALUE",52,10,SEQ)),"",10,79)
D TMP^VAQDIS20
D BLANK^VAQDIS20
Q
;
SORT ; -- sorts medication in alpha or by name
S SEQ=""
F J=1:1 S SEQ=$O(@XTRCT@("VALUE",52,.01,SEQ)) Q:SEQ="" D
.S VAQRXN=$G(@XTRCT@("VALUE",52,.01,SEQ))
.S VAQMED=$G(@XTRCT@("VALUE",52,6,SEQ))
.S ^TMP("VAQSORT",$J,VAQMED,VAQRXN)=SEQ
I J=1 D
.S X=$$SETSTR^VALM1("*** There is no Pharmacy Information",1,79)
.D TMP^VAQDIS20
.S VAQPOP=1
QUIT
;
REFILL ; -- Counts the number of refills by perscription number
S SEQ=""
F S SEQ=$O(@XTRCT@("ID",52.1,.01,SEQ)) Q:SEQ="" D
.S VAQRXNO=$G(@XTRCT@("ID",52.1,.01,SEQ))
.I '$D(VAQRF(VAQRXNO)) S VAQRF(VAQRXNO)=0
.S VAQRF(VAQRXNO)=VAQRF(VAQRXNO)+1
K SEQ,VAQRXNO
QUIT
;
EXIT ; -- Cleans up variables
K Z1,Z2,SEQ,TMP,TMP1,J
K VAQRXN,VAQTMP,VAQRFL,VAQREM,VAQINF,VAQMED,VAQRXNO
K ^TMP("VAQSORT",$J),VAQRF
QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQDIS43 4541 printed Nov 22, 2024@17:35:41 Page 2
VAQDIS43 ;ALB/JRP/JFP - PRINT ACTION PROFILE (CONT);30APR92
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
LONG ;PRINT LONG FORMAT
+1 SET VAQPOP=0
+2 DO SORT
if VAQPOP=1
QUIT
+3 DO REFILL
+4 DO LSORT
+5 DO EXIT
+6 QUIT
+7 ;
LSORT SET (Z1,Z2)=""
+1 FOR
SET Z1=$ORDER(^TMP("VAQSORT",$JOB,Z1))
if Z1=""
QUIT
DO LG0
+2 QUIT
LG0 FOR
SET Z2=$ORDER(^TMP("VAQSORT",$JOB,Z1,Z2))
if Z2=""
QUIT
DO LG1
+1 QUIT
+2 ;
LG1 ; -- Line 1
+1 SET SEQ=$GET(^TMP("VAQSORT",$JOB,Z1,Z2))
+2 SET VAQRXN=$GET(@XTRCT@("VALUE",52,.01,SEQ))
+3 SET X=$$SETSTR^VALM1("RX #: "_VAQRXN,"",1,79)
+4 DO TMP^VAQDIS20
LG2 ;
+1 SET X=$$SETSTR^VALM1($GET(@XTRCT@("VALUE",52,6,SEQ)),"",1,44)
+2 SET X=$$SETSTR^VALM1("SIG: "_$GET(@XTRCT@("VALUE",52,10,SEQ)),X,45,34)
+3 DO TMP^VAQDIS20
LG3 ;
+1 SET X=$$SETSTR^VALM1("QTY: "_$GET(@XTRCT@("VALUE",52,7,SEQ)),"",3,21)
+2 SET X=$$SETSTR^VALM1("# OF REFILLS: "_$GET(@XTRCT@("VALUE",52,9,SEQ)),X,23,22)
+3 SET VAQTMP=$$DATE^VAQUTL99($GET(@XTRCT@("VALUE",52,1,SEQ)))
+4 SET TMP=$$DOBFMT^VAQUTL99(VAQTMP,0)
+5 if (TMP=-1)
SET TMP=""
+6 if (TMP'="")
SET $PIECE(TMP,"-",3)=$EXTRACT($PIECE(TMP,"-",3),3,4)
+7 SET VAQTMP=$$DATE^VAQUTL99($GET(@XTRCT@("VALUE",52,26,SEQ)))
+8 SET TMP1=$$DOBFMT^VAQUTL99(VAQTMP,0)
+9 if (TMP1=-1)
SET TMP=""
+10 if (TMP1'="")
SET $PIECE(TMP1,"-",3)=$EXTRACT($PIECE(TMP1,"-",3),3,4)
+11 SET X=$$SETSTR^VALM1("ISSUE/EXPR: "_TMP_" / "_TMP1,X,45,34)
+12 DO TMP^VAQDIS20
LG4 ;
+1 SET X=$$SETSTR^VALM1("PHYS: "_$GET(@XTRCT@("VALUE",52,4,SEQ)),"",3,27)
+2 SET X=$$SETSTR^VALM1("CLERK: "_$GET(@XTRCT@("VALUE",52,16,SEQ)),X,30,15)
+3 SET VAQTMP=$$DATE^VAQUTL99($GET(@XTRCT@("VALUE",52,22,SEQ)))
+4 SET TMP=$$DOBFMT^VAQUTL99(VAQTMP,0)
+5 if (TMP=-1)
SET TMP=""
+6 if (TMP'="")
SET $PIECE(TMP,"-",3)=$EXTRACT($PIECE(TMP,"-",3),3,4)
+7 SET X=$$SETSTR^VALM1("FILL DATE: "_TMP,X,45,34)
+8 DO TMP^VAQDIS20
LG5 ;
+1 SET VAQTMP=$$DATE^VAQUTL99($GET(@XTRCT@("VALUE",52.1,.01,SEQ)))
+2 SET TMP=$$DOBFMT^VAQUTL99(VAQTMP,0)
+3 if (TMP=-1)
SET TMP=""
+4 if (TMP'="")
SET $PIECE(TMP,"-",3)=$EXTRACT($PIECE(TMP,"-",3),3,4)
+5 SET X=$$SETSTR^VALM1("REFILLED: "_TMP,"",3,79)
+6 DO TMP^VAQDIS20
LG6 ;
+1 SET X=$$SETSTR^VALM1("REMARKS: "_$GET(@XTRCT@("VALUE",52,12,SEQ)),"",3,79)
+2 DO TMP^VAQDIS20
LG7 ;
+1 SET X=$$SETSTR^VALM1("DIVISION: "_$GET(@XTRCT@("VALUE",52,20,SEQ)),"",3,38)
+2 SET X=$$SETSTR^VALM1($GET(@XTRCT@("VALUE",52,100,SEQ)),X,40,20)
+3 SET VAQTMP=$GET(@XTRCT@("VALUE",52,9,SEQ))
+4 SET VAQRFL=$SELECT($GET(VAQRF(VAQRXN))="":0,1:$GET(VAQRF(VAQRXN)))
+5 SET VAQREM=VAQTMP-VAQRFL
+6 SET X=$$SETSTR^VALM1(VAQREM_" REFILL"_$SELECT(VAQREM=1:"",1:"S"),X,60,17)
+7 DO TMP^VAQDIS20
+8 DO BLANK^VAQDIS20
+9 QUIT
+10 ;
SHORT ; -- Print short format
+1 SET VAQPOP=0
+2 DO SORT
if VAQPOP=1
QUIT
+3 DO REFILL
+4 DO SSORT
+5 DO EXIT
+6 QUIT
+7 ;
SSORT SET (Z1,Z2)=""
+1 FOR
SET Z1=$ORDER(^TMP("VAQSORT",$JOB,Z1))
if Z1=""
QUIT
DO SH0
+2 QUIT
SH0 FOR
SET Z2=$ORDER(^TMP("VAQSORT",$JOB,Z1,Z2))
if Z2=""
QUIT
DO SH1
+1 QUIT
+2 ;
SH1 ; -- Line 1
+1 SET SEQ=$GET(^TMP("VAQSORT",$JOB,Z1,Z2))
+2 SET VAQRXN=$GET(@XTRCT@("VALUE",52,.01,SEQ))
+3 SET X=$$SETSTR^VALM1(VAQRXN,"",1,7)
SH2 ;
+1 SET X=$$SETSTR^VALM1($GET(@XTRCT@("VALUE",52,6,SEQ)),X,8,37)
SH3 ;
+1 SET VAQTMP=$GET(@XTRCT@("VALUE",52,100,SEQ))
+2 SET X=$$SETSTR^VALM1($EXTRACT(VAQTMP,1),X,47,2)
SH4 ;
+1 SET VAQTMP=$GET(@XTRCT@("VALUE",52,7,SEQ))
+2 SET VAQINF=$JUSTIFY(VAQTMP,5)
+3 SET X=$$SETSTR^VALM1(VAQINF,X,49,5)
SH5 ;
+1 SET VAQTMP=$GET(@XTRCT@("VALUE",52,1,SEQ))
+2 SET VAQTMP=$$DATE^VAQUTL99(VAQTMP)
+3 SET TMP=$$DOBFMT^VAQUTL99(VAQTMP,0)
+4 if (TMP=-1)
SET TMP=""
+5 if (TMP'="")
SET $PIECE(TMP,"-",3)=$EXTRACT($PIECE(TMP,"-",3),3,4)
+6 SET X=$$SETSTR^VALM1(TMP,X,56,10)
SH6 ;
+1 SET VAQTMP=$GET(@XTRCT@("VALUE",52,101,SEQ))
+2 SET VAQTMP=$$DATE^VAQUTL99(VAQTMP)
+3 SET TMP=$$DOBFMT^VAQUTL99(VAQTMP,0)
+4 if (TMP=-1)
SET TMP=""
+5 if (TMP'="")
SET $PIECE(TMP,"-",3)=$EXTRACT($PIECE(TMP,"-",3),3,4)
+6 SET X=$$SETSTR^VALM1(TMP,X,66,10)
SH7 ;
+1 SET VAQTMP=$GET(@XTRCT@("VALUE",52,9,SEQ))
+2 SET VAQRFL=$SELECT($GET(VAQRF(VAQRXN))="":0,1:$GET(VAQRF(VAQRXN)))
+3 SET VAQREM=VAQTMP-VAQRFL
+4 SET X=$$SETSTR^VALM1("("_VAQREM_")",X,76,3)
+5 DO TMP^VAQDIS20
SH20 ; -- Line 2
+1 SET X=$$SETSTR^VALM1($GET(@XTRCT@("VALUE",52,10,SEQ)),"",10,79)
+2 DO TMP^VAQDIS20
+3 DO BLANK^VAQDIS20
+4 QUIT
+5 ;
SORT ; -- sorts medication in alpha or by name
+1 SET SEQ=""
+2 FOR J=1:1
SET SEQ=$ORDER(@XTRCT@("VALUE",52,.01,SEQ))
if SEQ=""
QUIT
Begin DoDot:1
+3 SET VAQRXN=$GET(@XTRCT@("VALUE",52,.01,SEQ))
+4 SET VAQMED=$GET(@XTRCT@("VALUE",52,6,SEQ))
+5 SET ^TMP("VAQSORT",$JOB,VAQMED,VAQRXN)=SEQ
End DoDot:1
+6 IF J=1
Begin DoDot:1
+7 SET X=$$SETSTR^VALM1("*** There is no Pharmacy Information",1,79)
+8 DO TMP^VAQDIS20
+9 SET VAQPOP=1
End DoDot:1
+10 QUIT
+11 ;
REFILL ; -- Counts the number of refills by perscription number
+1 SET SEQ=""
+2 FOR
SET SEQ=$ORDER(@XTRCT@("ID",52.1,.01,SEQ))
if SEQ=""
QUIT
Begin DoDot:1
+3 SET VAQRXNO=$GET(@XTRCT@("ID",52.1,.01,SEQ))
+4 IF '$DATA(VAQRF(VAQRXNO))
SET VAQRF(VAQRXNO)=0
+5 SET VAQRF(VAQRXNO)=VAQRF(VAQRXNO)+1
End DoDot:1
+6 KILL SEQ,VAQRXNO
+7 QUIT
+8 ;
EXIT ; -- Cleans up variables
+1 KILL Z1,Z2,SEQ,TMP,TMP1,J
+2 KILL VAQRXN,VAQTMP,VAQRFL,VAQREM,VAQINF,VAQMED,VAQRXNO
+3 KILL ^TMP("VAQSORT",$JOB),VAQRF
+4 QUIT
+5 ;
