source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMSTA2.m@ 1407

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

revised back to 6/30/08 version
File size: 5.0 KB
RevLine 
[623]1PXRMSTA2 ; SLC/AGP - Routines for building status list. ;9/26/2005
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4DATA(FILE,DA,TYPE,RXTYPE,STATUS) ;
5 ; this sub routine get the list of statuses from the apporiate global
6 ;
7 N ARRAY,ARRAY1,CNT,CODE,DEF,OUTPUT,SARRAY,STAT
8LOOP ;
9 ;get build status list into a local array from each pharmacy type of
10 ;finding item
11 I TYPE="DRUG" D
12 .I $D(RXTYPE("I"))>0 D
13 . . D FIELD^DID(55.06,28,"","POINTER","SARRAY")
14 . . D ARRAYFOR(.SARRAY,.ARRAY,"I") K CODE
15 . . D FIELD^DID(55.01,100,"","POINTER","SARRAY")
16 . . D ARRAYFOR(.SARRAY,.ARRAY1,"I") K CODE
17 . . D COMPARE(.ARRAY,.ARRAY1,"I",.OUTPUT)
18 . I $D(RXTYPE("O"))>0 D
19 . . K ARRAY,ARRAY1,CODE
20 . . D FIELD^DID(52,100,"","POINTER","SARRAY")
21 . . D ARRAYFOR(.SARRAY,.ARRAY,"O") K CODE
22 . . I $D(OUTPUT)>0 K ARRAY1 M ARRAY1=OUTPUT K OUTPUT D COMPARE(.ARRAY,.ARRAY1,"",.OUTPUT)
23 . . E M OUTPUT=ARRAY
24 . I $D(RXTYPE("N"))>0 D
25 . . K ARRAY,ARRAY1,CODE
26 . . D FIELD^DID(55.05,5,"","POINTER","SARRAY")
27 . . S SARRAY("POINTER")=SARRAY("POINTER")_"0:ACTIVE;"
28 . . D ARRAYFOR(.SARRAY,.ARRAY,"N") K CODE
29 . . I $D(OUTPUT)>0 K ARRAY1 M ARRAY1=OUTPUT K OUTPUT D COMPARE(.ARRAY,.ARRAY1,"",.OUTPUT)
30 . . E M OUTPUT=ARRAY
31 ;
32 I TYPE="PROB" S OUTPUT("ACTIVE")="ACTIVE",OUTPUT("INACTIVE")="INACTIVE"
33 I TYPE="ORD(101.43," D
34 . S CNT=0,STAT="" F S STAT=$O(^ORD(100.01,"B",STAT)) Q:STAT="" D
35 . . S CNT=CNT+1 S OUTPUT(STAT)=STAT
36 I TYPE="RAMIS(71,"!(TYPE="TAX") D
37 . S TYPE="RAMIS(71,"
38 . S CNT=0,STAT="" F S STAT=$O(^RA(72,"B",STAT)) Q:STAT="" D
39 . . S CNT=CNT+1 S OUTPUT(STAT)=STAT
40 .;I TYPE'="TAX" Q
41 .;I '$D(OUTPUT("ACTIVE")) S OUTPUT("ACTIVE")="ACTIVE"
42 .;I '$D(OUTPUT("INACTIVE")) S OUTPUT("INACTIVE")="INACTIVE"
43 D SELECT(.OUTPUT,FILE,TYPE,.STATUS,.DA)
44 ;
45 Q
46 ;
47COMPARE(ARRAY,ARRAY1,TYPE,OUTPUT) ;
48 ; this sub routine is use to combine the InPatient and
49 ; Both Pharmacy type into one array
50 N ARY,CNT,COMP,NODE
51 K OUTPUT
52 S COMP=""
53 ;
54 ;inpatient pharmacy list is built from two seperated fields in file #55
55 ;this is used to combined the two fields into one array
56 I $G(TYPE)="I" D
57 . F S COMP=$O(ARRAY(COMP)) Q:COMP="" D
58 . . S OUTPUT(COMP)=ARRAY(COMP)
59 . S (COMP)="" F S COMP=$O(ARRAY1(COMP)) Q:COMP="" D
60 . . I '$D(OUTPUT(COMP)) S OUTPUT(COMP)=ARRAY1(COMP)
61 ;
62 ;this section is uses to combine the different RX Types into one array
63 I $G(TYPE)'="I" D
64 . F S COMP=$O(ARRAY(COMP)) Q:COMP="" D
65 . . S NODE=$G(ARRAY(COMP))
66 . . S OUTPUT(COMP)=NODE
67 . S COMP="" F S COMP=$O(ARRAY1(COMP)) Q:COMP="" D
68 . . S NODE=$G(ARRAY1(COMP))
69 . . I '$D(OUTPUT(COMP)) S OUTPUT(COMP)=NODE Q
70 . . I $D(OUTPUT(COMP)) S $P(OUTPUT(COMP),U,2)=$P(OUTPUT(COMP),U,2)_$P(NODE,U,2)
71 Q
72 ;
73ARRAYFOR(ARRAY,OUTPUT,DEF) ;
74 ;this sub routine is use to format that array data into a standard
75 ;format
76 ;
77 N CNT,COMP,PIECE,STR,TYPE
78 S PIECE=0
79 ;
80 ;determine the number of pieces minus one in the string
81 F CNT=1:1:$L(ARRAY("POINTER")) I $E(ARRAY("POINTER"),CNT)=";" S PIECE=PIECE+1 I PIECE>0 D
82 . S STR=$P($P($G(ARRAY("POINTER")),";",PIECE),":",2)
83 . S OUTPUT($P($P($G(ARRAY("POINTER")),";",PIECE),":",2))=STR_U_$G(DEF)
84 ;
85 ;add last piece in the string to the array
86 I PIECE>0 S PIECE=PIECE+1 D
87 . I $P($G(ARRAY("POINTER")),";",PIECE)'="" D
88 . . S OUTPUT($P($P($G(ARRAY("POINTER")),";",PIECE),":",2))=$P($P($G(ARRAY("POINTER")),";",PIECE),":",2)_U_$G(DEF)
89 Q
90 ;
91SELECT(ARRAY,FILE,TYPE,STATUS,DA) ;
92 ; this sub routine is use to sort through the formated array and
93 ; set up the DIR call
94 ;
95 N CHECK,CNT,CNT1,DIR,DUOUT,DTOUT,EMPTY,EXTR
96 N HELP,LENGTH,NODE,STAT,STR,TEXT,TMP,X,Y
97 N TMPARR,NUM
98DISPLAY ;
99 I TYPE="DRUG" S TEXT="Select a Medication Status or enter '^' to Quit",HELP="Select a status from the Medication Status list or '^' to Quit"
100 I TYPE="ORD(101.43," S TEXT="Select a Order Status from or enter '^' to Quit",HELP="Select a Order Status from the status list or '^' to Quit"
101 I TYPE="RAMIS(71," S TEXT="Select a Radiology Procedure Status or enter '^' to Quit",HELP="Select a Radiology Procedure Status from the status list or '^' to Quit"
102 ;I TYPE="TAX" S TEXT="Select a Taxonomy Status or enter '^' to Quit",HELP="Select a Taxonomy Status from the status list or '^' to Quit"
103 ;I TYPE="PROB" S TEXT="Select a Problem Status or enter '^' to Quit",HELP="Select a Taxonomy Status from the status list or '^' to Quit"
104 ;
105 S CNT=0,CNT1=0,STAT=""
106 ;if text is not entered into the prompt or no match is found display
107 ;entire list of statuses for this finding item
108 ;
109 ;Add wildcard character
110 S CNT=CNT+1,CNT1=CNT1+1,TMP(CNT)=CNT_" - * (WildCard)",TMPARR(CNT)="*"
111 ;Add status from file to the selectable list
112 F S STAT=$O(ARRAY(STAT)) Q:STAT="" D
113 . S NODE=$G(ARRAY(STAT))
114 . S STR=$P(NODE,U)
115 . S CNT=CNT+1,CNT1=CNT1+1
116 . I TYPE="DRUG" S TMP(CNT)=CNT_" - "_STR_"("_$P(NODE,U,2)_")",TMPARR(CNT)=STR
117 . E S TMP(CNT)=CNT_" - "_STR,TMPARR(CNT)=STR
118 ;
119 S DIR(0)="LO^1:"_CNT_""
120 M DIR("A")=TMP
121 S DIR("A")=TEXT
122 S DIR("?")=HELP
123 D ^DIR
124 I $D(DTOUT)!($D(DUOUT))!($G(Y)="") K STATUS Q
125 S CNT=0 F X=1:1:$L(Y(0)) D
126 .I $E(Y(0),X)="," S CNT=CNT+1,NUM=$P(Y(0),",",CNT),STATUS(TMPARR(NUM))=""
127 ;S STATUS=Y(0)
128 ;I STATUS="WildCard" S STATUS="*"
129 Q
130 ;
Note: See TracBrowser for help on using the repository browser.