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