source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQDIS43.m@ 1804

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
 ;