149 lines
4.3 KiB
Mathematica
149 lines
4.3 KiB
Mathematica
|
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
|
||
|
|
;
|