source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIULMED3.m@ 862

Last change on this file since 862 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.0 KB
RevLine 
[613]1TIULMED3 ; SLC/MAM - Cont. of Active/Recent Med Objects Routine ;1/30/07
2 ;;1.0;TEXT INTEGRATION UTILITIES;**198,213**;Jun 20, 1997;Build 3
3GETCLASS ; Get Drug Class, filter out supplies BP/ELR
4 I +DRUGIDX D
5 .N TEMPNODE
6 .S DRUGCLAS=$$DRGCLASS^TIULMED2(DRUGIDX)
7 .S TEMPNODE=U_DRUGCLAS_U_$$DEA^TIULMED2(DRUGIDX)
8 .I 'SUPPLIES,($E(DRUGCLAS,1,2)="XA") D
9 ..S KEEPMED='($P(TEMPNODE,U,3)["S")
10 Q
11 ;
12PATCHSOK() ; Function Checks for Pharmacy Package and required patches
13 ;Returns 1 if ok, 0 if not
14 N CHECKOK S CHECKOK=1
15 I '$L($T(OCL^PSOORRL)) D S CHECKOK=0 G CKX
16 . D ADD^TIULMED1("Outpatient Pharmacy 7.0 Required for this Object.")
17 . D ADD^TIULMED1(" ")
18 I '$$PATCH^XPDUTL("PSO*7.0*20") D S CHECKOK=0 G CKX
19 . D ADD^TIULMED1("Outpatient Pharmacy Patch PSO*7.0*20 is required for this Object.")
20 . D ADD^TIULMED1(" ")
21 I '$$PATCH^XPDUTL("PSJ*5.0*22") D S CHECKOK=0 G CKX
22 . D ADD^TIULMED1("Inpatient Pharmacy Patch PSJ*5.0*22 is required for this Object.")
23 . D ADD^TIULMED1(" ")
24CKX Q CHECKOK
25 ;
26SORTSAVE ;Sort & save Meds Data in TARGET
27 ; *** Check for empty condition ***
28 ;
29 I EMPTY D G SORTX
30 .D ADD^TIULMED1("No Medications Found")
31 .D ADD^TIULMED1(" ")
32 ;
33 ; *** Sort Meds in "C" temp xref - sort by Med Type, Status
34 ; Med Name, and reverse issue date, followed by a counter
35 ; to avoid erasing meds issued on the same day
36 ;
37 N MED,CNT,XSTR,TIUXSTAT
38 N DATA,NODE
39 S MED="",CNT=1000000
40 F S MED=$O(@TARGET@("B",MED)) Q:MED="" D
41 .S (XSTR,TIUXSTAT)=""
42 .F S XSTR=$O(@TARGET@("B",MED,XSTR)) Q:XSTR="" D
43 .. F S TIUXSTAT=$O(@TARGET@("B",MED,XSTR,TIUXSTAT)) Q:TIUXSTAT="" D
44 ...S NODE=@TARGET@("B",MED,XSTR,TIUXSTAT)
45 ...S DATA=$P(NODE,U,3)_U_$P(NODE,U,5)_U_MED,CNT=CNT+1
46 ...S @TARGET@("C",DATA,(9999999-$P(NODE,U))_CNT)=$P(NODE,U,2)_U_$P(NODE,U,4)
47 ;
48 ; Read sorted data and save final version to TARGET
49 ;
50 N LASTCLAS,LASTMEDT,LASTSTS,COUNT,TOTAL
51 N INDEX,MEDTYPE,STATIDX,DRUGCLAS,TYPE
52 N NODE,LASTMEDT,LASTSTS,TEMP,OLDTAB,OLDHEADR
53 S (DATA,LASTCLAS)="",(LASTMEDT,LASTSTS,COUNT,TOTAL)=0
54 D WARNING^TIULMED1
55 F S DATA=$O(@TARGET@("C",DATA)) Q:DATA="" D
56 .S MEDTYPE=$E(DATA),STATIDX=$E(DATA,2)
57 .S DRUGCLAS=$P(DATA,U,2),MED=$P(DATA,U,3),CNT=""
58 .F S CNT=$O(@TARGET@("C",DATA,CNT)) Q:CNT="" D
59 ..S INDEX=@TARGET@("C",DATA,CNT)
60 ..S TYPE=$P(INDEX,U,2),INDEX=+INDEX
61 ..S NODE=^TMP("PS",$J,INDEX,0)
62 ..I $P($P(NODE,U),";")["N" S $P(NODE,U,2)="Non-VA "_$P(NODE,U,2)
63 ..I (MEDTYPE'=LASTMEDT)!(STATIDX'=LASTSTS) D ; Create Header
64 ...I CLASSORT'=2,DRUGCLAS'=" " S LASTCLAS=DRUGCLAS
65 ...I 'HEADER Q
66 ...S LASTMEDT=MEDTYPE,LASTSTS=STATIDX,TAB=0
67 ...I COUNT>0 D ADD^TIULMED1(" ")
68 ...I CLASSORT D ADD^TIULMED1(" ")
69 ...S COUNT=0
70 ...I DETAILED D
71 ....I MEDTYPE=OUTPTYPE D I 1
72 .....D ADD^TIULMED1(SPACE60_"Issue Date")
73 .....D ADD^TIULMED1($E($E(SPACE60,1,47)_"Status"_SPACE60,1,60)_"Last Fill")
74 ....E D ADD^TIULMED1(SPACE60_"Start Date")
75 ...I 'ONELIST D
76 ....S TEMP=$S(STATIDX=1:"Active",STATIDX=2:"Pending",1:"Inactive")_" "
77 ...E S TEMP=""
78 ...S TEMP=TEMP_$S(MEDTYPE=INPTYPE:"Inpatient",MEDTYPE=NVATYPE:"Non-VA",1:"Outpatient")
79 ...S TEMP=" "_TEMP_" Medications"
80 ...I CLASSORT D
81 ....I DETAILED S TEMP=TEMP_" (By Class)"
82 ....E S TEMP=TEMP_" (By Drug Class)"
83 ...I DETAILED D I 1
84 ....S TEMP=$E(TEMP_SPACE60,1,47)
85 ....I MEDTYPE=INPTYPE S TEMP=TEMP_"Status"
86 ....E S TEMP=TEMP_"Refills"
87 ....S TEMP=$E(TEMP_SPACE60,1,60)
88 ....I MEDTYPE=INPTYPE S TEMP=TEMP_"Stop Date"
89 ....E S TEMP=TEMP_"Expiration"
90 ...E D
91 ....S TEMP=$E(TEMP_SPACE60,1,60)_"Status"
92 ...D ADD^TIULMED1(TEMP),ADD^TIULMED1(DASH73)
93 ..I CLASSORT,DRUGCLAS'="",DRUGCLAS'=LASTCLAS D
94 ...S LASTCLAS=DRUGCLAS,OLDTAB=TAB,OLDHEADR=HEADER
95 ...S (TAB,HEADER)=0
96 ...I COUNT>0 D ADD^TIULMED1(" ")
97 ...I (CLASSORT=2)!(DRUGCLAS=" ") D I 1
98 ....I DRUGCLAS=" " S TEMP=" ====== Drug Class Unknown "
99 ....E S TEMP=" ====== Drug Class: "_DRUGCLAS_" "
100 ...E S TEMP=" "
101 ...S TEMP=$E(TEMP_DASH73,1,LLEN-2)
102 ...D ADD^TIULMED1(TEMP)
103 ...S HEADER=OLDHEADR,TAB=OLDTAB
104 ..S COUNT=COUNT+1,TOTAL=TOTAL+1
105 ..D ADDMED^TIULMED1(0)
106 I COUNT'=TOTAL D
107 .S TAB=0
108 .D ADD^TIULMED1(" ")
109 .D ADD^TIULMED1(TOTAL_" Total Medications")
110SORTX ;
111 Q
112 ;
Note: See TracBrowser for help on using the repository browser.