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

GMTSPSHO.m

Go to the documentation of this file. 
  1. GMTSPSHO ; SLC OIFO/GS - Herbal/OTC Medications Health Summary; 01/26/2004
  1.  ;;2.7;Health Summary;**65**;Oct 20, 1995
  1.  ;v6;04/07/2004
  1.  ;
  1.  ; External References
  1.  ;   DBIA    330  ^PSOHCSUM which includes ^TMP("PSOO",$J)
  1.  ;   DBIA  10003  DD^%DT
  1.  ;   DBIA  10035  ^DPT(  file #2
  1.  ;   DBAI  10060  ^VA(200
  1.  ;                 
  1.  ; Format of ^TMP("PS00",$J,"NVA",ILFD,0) as G1 aka GMRC
  1.  ;  (see also ^PSOHCSUM):
  1.  ;                 
  1.  ; Field Descriptions    Defined                 AKA/Notes
  1.  ; Orderable Item        $P(G1,U)                Includes dosage form
  1.  ;                                                 (File # 50.7)
  1.  ; Status                $P(G1,U,2)
  1.  ; Discontinued Date     $P(G1,U,7)              FM format
  1.  ; Order #               $P(G1,U,4)              CPRS Order #  ptr to
  1.  ;                                                 File #100
  1.  ; Documented By         $P($P(G1,U,6),";",2)    Doc. by Name  ptr to
  1.  ;                                                 File #200 is $P(x;1)
  1.  ; Documented Date       $P(G1,U,5)              FM format (Entered On)
  1.  ; Clinic                $P($P(G2,U,5),";",2)    Clinic Name  ptr to
  1.  ;                                                 File #44 is $P(x;1)
  1.  ; Date Started          $P(G1,U,3)              FM format (Start Date)
  1.  ; Drug                  $P($P(G2,U,4),";",2)    Drug name (Dispensed)
  1.  ;                                                 ptr to f#50 is $P(x;1)
  1.  ; Dosage                $P(G2,U)
  1.  ; Medication Route      $P(G2,U,2)
  1.  ; Schedule              $P(G2,U,3)
  1.  ; Statement/Explanation ^TMP("PSOO",$J,"NVA",ILFD,"DSC",nn,0)
  1.  ;                 
  1.  ;      where G1=^TMP("PSOO",$J,"NVA",ILFD,0)
  1.  ;            G2=^TMP("PSOO",$J,"NVA",ILFD,1,0)
  1.  ;            nn & nnn = sequentual integers
  1.  ;                 
  1.  ; Variables  Descriptions
  1.  ; CT         Counter of number of Herbal/OTC/Non-VA drugs for patient
  1.  ; DFN        Patient internal number passed in
  1.  ; DGR        Documented by's degree
  1.  ; ILFD       Inverse Last Fill Date (FM format)
  1.  ; JOB        $J
  1.  ; G1,G2      Abstracted data strings from ^TMP("PSOO", - see MAIN & WRT
  1.  ; GMT*       Variables used by HS pagination routine (GMTSUP), e.g.,
  1.  ;               GMTSLPG=last page, GMTSTITL=title
  1.  ; LL*        Line lengths ('^' delimited) for override reason & S/E
  1.  ; NEWFORM    ;
  1.  ; NL         Sequential line counter for override reasons &
  1.  ;               statement/explanation
  1.  ; T1,T2,T3   Integer tab stops for data display - see MAIN
  1.  ; T4         Tab stops (#,#) for override reason display
  1.  ; T5         Tab stops for Stmt/Expln display
  1.  ; V          Line header verbiage describing data displayed
  1.  ; VARY       Array of verbiage to be displayed (override reason & S/E)
  1.  ; Y          Scratch system variable
  1.  ;
  1.  ; Global Variables (variables defined outside this routine)
  1.  ; DFN, GMTSNPG, GMTSQIT
  1.  ;                 
  1. MAIN ; Herbal/Over-the-Counter/Non-VA Medications
  1.  N CHAW,CLL,CT,DGR,G1,G2,GMTOP,GMX,I,ILFD,ILN,JOB,LINE,LL
  1.  N LL5,LP,MAX,NL,OLN,PLN,T1,T2,T3,T4,T5,V,VARY,VO,X,Y
  1.  S ILFD=0,JOB=$J,LL5="40^65"
  1.  S T1=16,T2=58,T3=33,T4="25,10",T5="33,10"
  1.  ; Set variables for use by report pagination routine (GMTSUP)
  1.  S CT=0,MAX=999,GMX=0
  1.  ; Check to see if a patient IEN is defined
  1.  I DFN="" D CKFORM W !?8,"No patient selected" Q
  1.  ; Check page line count and print new page and header if necessary
  1.  D CKFORM Q:$D(GMTSQIT)
  1.  ; Output header for report
  1.  D:GMTSNPG!(GMX'>0) HDR Q:$D(GMTSQIT)  D CKFORM Q:$D(GMTSQIT)
  1.  W:'GMTOP ! S GMTOP=0,GMX=1
  1.  ; Run Pharmacy extraction
  1.  D ^PSOHCSUM  ; DBIA 330
  1.  ; Quit if no herbals/non-VA drugs extracted - ^TMP("PSOO") via DBIA 330
  1.  I '$D(^TMP("PSOO",JOB,"NVA")) D CKFORM W !,?8,"No Non-VA Meds Extracted" Q
  1.  ; Loop through ^TMP global array created by ^PSOHCSUM  ; DBIA 330
  1.  ;   Quit if   1  Inverse Last Fill Date =0
  1.  ;             2  Counter is not less than Max Occurrence
  1.  ;             3  User has "up-arrowed" out of the display
  1.  F  S ILFD=$O(^TMP("PSOO",JOB,"NVA",ILFD)) Q:+ILFD=0!(CT'<MAX)!($D(GMTSQIT))  D
  1.  . S G1=^TMP("PSOO",JOB,"NVA",ILFD,0)
  1.  . S G2=^TMP("PSOO",JOB,"NVA",ILFD,1,0),CT=CT+1
  1.  . D WRT
  1.  K ^TMP("PSOO",$J)  ;delete temporary file created via PSOHCSUM
  1.  Q
  1.  ;                 
  1. WRT ; Write Data
  1.  D CKFORM Q:$D(GMTSQIT)  ;line/pagination check - repeated ad nauseum
  1.  D:GMTSNPG!(GMX'>0) HDR Q:$D(GMTSQIT)
  1.  D CKFORM Q:$D(GMTSQIT)
  1.  S V="Non-VA Med: " W !?T1-$L(V),V,$P(G1,U)
  1.  D CKFORM Q:$D(GMTSQIT)
  1.  S V="Status: " W !?T1-$L(V),V,$P(G1,U,2)
  1.  ; Display discontinued date if it exists (assume discontinued status)
  1.  S Y=$P(G1,U,7) I Y D DD^%DT W " (",$P(Y,"@"),")"  ; DBIA 10003
  1.  S V="CPRS Order #: " W ?T2-$L(V),V,$P(G1,U,4)
  1.  D CKFORM Q:$D(GMTSQIT)
  1.  S V="Documented By: " W !?T1-$L(V),V,$P($P(G1,U,6),";",2)
  1.  I $P($P(G1,U,6),";") D DEGREE W:DGR'="" ",",DGR
  1.  S V="Documented Date: ",Y=$P(G1,U,5) D DD^%DT W ?T2-$L(V),V,Y  ; DBIA 10003
  1.  D CKFORM Q:$D(GMTSQIT)
  1.  S V="Clinic: "
  1.  W !?T1-$L(V),V,$P($P(G2,U,5),";"),"-",$P($P(G2,U,5),";",2)
  1.  S V="Start Date: ",Y=$P(G1,U,3) D DD^%DT W ?T2-$L(V),V,Y  ; DBIA 10003
  1.  D CKFORM Q:$D(GMTSQIT)
  1.  S V="Dispense Drug: " W !?T1-$L(V),V,$P($P(G2,U,4),";",2)
  1.  S V="Dosage: " W ?T2-$L(V),V,$P(G2,U)
  1.  D CKFORM Q:$D(GMTSQIT)
  1.  S V="Med Route: " W !?T1-$L(V),V,$P(G2,U,2)
  1.  S V="Schedule: " W ?T2-$L(V),V,$P(G2,U,3)
  1.  S V="Statement/Explanation/Comment: ",NL=""
  1.  D CKFORM Q:$D(GMTSQIT)
  1.  W !
  1.  D CKFORM Q:$D(GMTSQIT)
  1.  W !?T3-$L(V),V
  1.  K V M V=^TMP("PSOO",JOB,"NVA",ILFD,"DSC")
  1.  ; Statement/Explanation verbiage
  1.  D LINES(LL5,.V) K V D LINESOUT(T5)
  1.  D CKFORM W !
  1.  K VO,X,Y
  1.  Q
  1.  ;
  1. LINESOUT(TN) ;WRITE LINES
  1.  F  S NL=$O(VO(NL)) Q:NL=""!$D(GMTSQIT)  D
  1.  . I NL=1 W ?$P(TN,","),VO(NL)
  1.  . E  D CKFORM Q:$D(GMTSQIT)  W !?$P(T4,",",2),VO(NL)
  1.  Q
  1.  ;                 
  1. LINES(LL,V) ;BREAK LINES OF AN ARRAY INTO APPROPRIATE MAX LENGTHS
  1.  ;                 
  1.  ; Input:
  1.  ; LL   = line lengths, e.g., 20^30^40 where last remains default
  1.  ; V    = input array w/ no null lines, use " " for blank line
  1.  ;                 
  1.  ;Output:
  1.  ; OV   = output array of lines broken into specified maximum lengths
  1.  ;                 
  1.  ; This subroutine takes an array of text (V) and breaks the text into
  1.  ;   line lengths as dictated via LL. Where the first line length (max)
  1.  ;   of the resulting array (VO) will be (approximately, based on line
  1.  ;   contents) $P(LL,"^",1), the second line length (max) will be
  1.  ;   $P(LL,"^",2), etc. The last line length in LL becomes the default
  1.  ;   maximum line length for all the remaining lines.
  1.  ;                 
  1.  ; This subroutine is useful if you want lines output in different
  1.  ;   lengths.
  1.  ;                 
  1.  ; Variables used:
  1.  ; CHAW   = the next piece of a line of a maximum byte length
  1.  ; CLL    = current line length (max)
  1.  ; I      = scratch variable
  1.  ; ILN    = input array line number
  1.  ; LP     = pointer indicating where in a line the last chaw taken
  1.  ; OLN    = output (resulting) line number
  1.  ; PLN    = previous line length (max)
  1.  ; X      = line being parsed for a breaking point
  1.  ;                 
  1.  N CHAW,CLL,ILN,LP,OLN,PLN
  1.  K VO
  1.  S (I,ILN,X)="",OLN=1,CLL=$P(LL,U,OLN),PLN=CLL
  1.  F  S ILN=$O(V(ILN)) Q:ILN=""  S LP=1 D
  1.  . S I=$E($RE(V(ILN,0)))
  1.  . S V(ILN,0)=V(ILN,0)_$S("!?."[I:"  ",",;:"[I!(I?1A):" ",1:"")
  1.  . I V(ILN,0)=" " S:X'="" VO(OLN)=X,X="",OLN=OLN+1 S VO(OLN)=" ",OLN=OLN+1 Q
  1.  . F  S CHAW=$E(V(ILN,0),LP,LP+CLL-$L(X)),LP=LP+$L(CHAW),X=X_CHAW Q:CHAW=""!($L(X)<CLL)  D
  1.  .. I $L(X)<CLL S VO(OLN)=X,X="" D LINESET Q
  1.  .. I X'[" "&($L(X)=CLL) S VO(OLN)=X_"-",X="" D LINESET Q
  1.  .. F I=$L(X):-1:1 Q:$E(X,I)=" "!($E(X,I)="-")
  1.  .. S VO(OLN)=$E(X,1,I),X=$E(X,I+1,999) D LINESET
  1.  S:X'="" VO(OLN)=X
  1.  Q
  1.  ;                 
  1. LINESET ; Used by LINES for setting variables
  1.  S OLN=OLN+1,PLN=CLL,CLL=$P(LL,U,OLN) S:+CLL=0 CLL=PLN
  1.  Q
  1.  ;
  1. CKFORM ; Checks to determine whether to do a form feed or not
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  Q
  1.  ;
  1. HDR ; Prints Header
  1.  S GMTOP=1
  1.  I GMX'>0 D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  I 'GMTSNPG D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  Q
  1.  ;
  1. DEGREE ; Gets degree of 'Documented by' individual & converts to upper case
  1.  S DGR=$$GET1^DIQ(200,$P($P(G1,U,6),";"),10.6)  ; DBIA 10060
  1.  S DGR=$TR(DGR,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1.  Q