source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMSTA2.m@ 1681

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

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