source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXBUTL.m@ 899

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

initial load of FOIAVistA 6/30/08 version
File size: 4.7 KB
Line 
1PXBUTL ;ISL/JVS,ESW - UTILITIES FOR PROMPTS ; 10/31/02 12:13pm
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**32,108**;Aug 12, 1996
3 ;
4 ;
5 ;
6WAIT ;--SPINNING CURSOR
7 I PXBMOD=20 W IOCUB,"\"
8 I PXBMOD=40 W IOCUB,"|"
9 I PXBMOD=60 W IOCUB,"/"
10 I PXBMOD=80 W IOCUB,"-"
11 Q
12CASE ;--CHANGE LOWER CASE TO UPPER CASE
13 I $D(DATA) S DATA=$TR(DATA,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
14 I $D(EDATA) S EDATA=$TR(EDATA,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
15 I $D(NARR) S NARR=$TR(NARR,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
16 Q
17PRIM ;--PRIMARY PROVIDER
18 N PXBSKY,PXBKY,PXBSAM,PXBCNT,PRVDR,FPRI
19 D PRV^PXBGPRV(PXBVST,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)
20 I $D(PRVDR) Q
21 I '$D(PXBSKY) Q
22 ;
23 D RSET^PXBDREQ("PRV")
24 S $P(REQI,"^",7)=$O(PXBSKY(1,0))
25 S $P(REQI,"^",2)="P"
26 S $P(REQI,"^",1)=$P(^AUPNVPRV($O(PXBSKY(1,0)),0),"^",1)
27 ;
28 D EN0^PXBSTOR(PXBVST,PATIENT,REQI)
29 D EN1^PXKMAIN
30 Q
31PRIMD ;--PRIMARY DIAGNOSIS
32 D POV^PXBGPOV(PXBVST)
33 I $D(PXDIGNS) Q
34 I '$D(PXBSKY) Q
35 ;
36 D RSET^PXBDREQ("POV")
37 S $P(REQI,"^",9)=$O(PXBSKY(1,0))
38 S $P(REQI,"^",6)="P"
39 S $P(REQI,"^",5)=$P(^AUPNVPOV($O(PXBSKY(1,0)),0),"^",1)
40 ;
41 D EN0^PXBSTOR(PXBVST,PATIENT,REQI)
42 D EN1^PXKMAIN
43 Q
44 ;
45 ;
46HDR(PXBVST,NO,PXBIOF) ;--Header for each screen PATIENT and DATE/TIME of Visit
47 N DATE,DIC,DIQ,DATE,DA,DR
48 N CLINICE
49 I '$D(IORVON) D TERM^PXBCC
50 S DIC=9000010,DR=".01;.05;.22",DA=PXBVST,DIQ="AMANDA(",DIQ(0)="EI" D EN^DIQ1
51 S PATIENT=$G(AMANDA(9000010,PXBVST,.05,"I"))
52 S NAME=$G(AMANDA(9000010,PXBVST,.05,"E"))
53 S DATE=$G(AMANDA(9000010,PXBVST,.01,"E"))
54 S IDATE=$G(AMANDA(9000010,PXBVST,.01,"I"))
55 S CLINIC=$G(AMANDA(9000010,PXBVST,.22,"I"))
56 S CLINICE=$G(AMANDA(9000010,PXBVST,.22,"E"))
57 I $L(CLINICE)>20 S CLINICE=$E(CLINICE,1,20)
58 K AMANDA
59 I '$G(PXBIOF) W @IOF
60 ;
61 I '$G(NO) W !
62 I $G(NO) D
63 .W IOINHI,!,IOCUU,"PAT/APPT/CLINIC: ",$E(NAME,1,18)," ",DATE,?((IOM-2)-$L(CLINICE)),CLINICE,IOINLOW
64 Q
65HDR2(FROM) ;--SECOND LINE IN THE HEADER
66 I '$D(FROM) Q
67 I FROM="STP" D LOC^PXBCC(1,0) D
68 .I PXBCNT=0 W "STOP CODE: ..There are ",$G(PXBCNT)," STOP CODES associated with this ENCOUNTER",IOELEOL
69 .I PXBCNT=1 W "STOP CODE: ..There is ",$G(PXBCNT)," STOP CODE associated with this ENCOUNTER",IOELEOL
70 .I PXBCNT>1 W "STOP CODE: ..There are ",$G(PXBCNT)," STOP CODES associated with this ENCOUNTER",IOELEOL
71 .D UNDON^PXBCC
72 .W !
73 .F W $C(32) Q:$X=(IOM-(4))
74 .D UNDOFF^PXBCC
75 ;
76 ;
77 ;
78 I FROM="PRV" D LOC^PXBCC(1,0) D
79 .I PXBCNT=0 W "PROVIDER: ..There are ",$G(PXBCNT)," PROVIDERS associated with this ENCOUNTER",IOELEOL
80 .I PXBCNT=1 W "PROVIDER: ..There is ",$G(PXBCNT)," PROVIDER associated with this ENCOUNTER",IOELEOL
81 .I PXBCNT>1 W "PROVIDER: ..There are ",$G(PXBCNT)," PROVIDERS associated with this ENCOUNTER",IOELEOL
82 .D UNDON^PXBCC
83 .W !
84 .F W $C(32) Q:$X=(IOM-(4))
85 .D UNDOFF^PXBCC
86 Q
87HDR3(DFN,NO,PXBIOF) ;--Header for each screen PATIENT and DATE/TIME of Visit
88 ;
89 ; NO = IF 1 then just do line feed don't do header
90 ; PXBIOF = IF 1 then don't W @IOF
91 ;
92 ;
93 N DATE,DIC,DIQ,DATE,DA,DR
94 N NAME,SEX,AGE,SSN
95 I '$D(IORVON) D TERM^PXBCC
96 S DIC=2,DR=".01;.02;.033;.09",DA=DFN,DIQ="AMANDA(",DIQ(0)="EI" D EN^DIQ1
97 S NAME=$G(AMANDA(2,DFN,.01,"E"))
98 S SEX=$G(AMANDA(2,DFN,.02,"E"))
99 S AGE=$G(AMANDA(2,DFN,.033,"E"))
100 S SSN=$G(AMANDA(2,DFN,.09,"E"))
101 S SSN=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
102 K AMANDA
103 I '$G(PXBIOF) W @IOF
104 ;
105 I '$G(NO) W !
106 I $G(NO) W IOINHI,!,IOCUU,"PAT/SEX/AGE/SSN: ",$E(NAME,1,18)," ",SEX," ",AGE_" Years ",?67,SSN W IOINLOW
107 Q
108 ;
109TIMES(ENT) ;--Number of time the selection appears in v file from PXBKY
110 ;
111 N N
112 S N=0,Q=0 F S N=$O(PXBKY(ENT,N)) Q:N="" S Q=Q+1,Q(N)=""
113 Q
114 ;
115CPTOK(CODE,IDATE) ;--check the historical date to see if it was active
116 ;TO BE USED AS A FUNCTION (W $$CPT......)
117 ; OK=1-- IT WAS ACTIVE
118 ; OK=0-- IT WAS NOT ACTIVE
119 ; RETURNS OK^INTERNAL FORM OF STATUS DATE^EXTERNAL FORM
120 N STADATE,STAFLAG,EDATE,STATUS,Y,DATE
121 S DATE=$P(IDATE,".",1)
122 S STATUS=$P($$CPT^ICPTCOD(CODE,DATE),U,6,7),STADATE=+STATUS,OK=+$P(STATUS,U,2)
123 S X=STADATE D H^%DTC,YX^%DTC S EDATE=Y K X,Y,%H,%T,%Y
124 Q OK_"^"_STADATE_"^"_EDATE
125 ;
126CPTSCREN(CODE,IDATE) ;
127 N OK,DATE
128 S DATE=$P(IDATE,".",1)
129 S OK=$P($$CPT^ICPTCOD(CODE,DATE),U,7)
130 Q +OK
131 ;
132CONPRV(PRV) ;---FUNCTION-Convert internal form or provider to external form
133 N DIC,DA,DR,DIQ,PXBPRV
134 S DIC=200,DA=PRV,DR=.01,DIQ="PRVA(",DIQ(0)="E" D EN^DIQ1
135 S PRV=$G(PRVA(200,PRV,.01,"E")) K PRVA
136 Q PXBPRV_"^"_PRV
137 ;
138NONE(NO) ;----Display's a None message to the screen if none is found
139 N X
140 I NO=1 S X="No PROVIDERS for this Encounter." D W
141 I NO=2 S X="No CPT CODES for this Encounter." D W
142 I NO=3 S X="No DIAGNOSIS for this Encounter." D W
143 I NO=4 S X="No PROBLEM LIST for this PATIENT." D W
144 I NO=5 S X="No STOP CODE for this ENCOUNTER." D W
145 I NO=6 S X="No ENCOUNTERS for this PATIENT." D W
146 Q
147W W !,?(IOM-$L(X))\2,IOINHI,X,IOINLOW
148 Q
Note: See TracBrowser for help on using the repository browser.