Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAQDIS43

VAQDIS43.m

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