source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCHS1.m@ 1524

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1DVBCHS1 ;ALB/JRP - C & P EXTRACT FOR HEALTH SUMMARY (CONT);11-JAN-95
2 ;;2.7;AMIE;;Apr 10, 1995
3OUT0(PTR,ARR) ;SET NODE ZERO OF OUTPUT
4 ;INPUT : PTR - Pointer to 2507 EXAM file (#396.4)
5 ; ARR - Where to place output (full global reference)
6 ;OUTPUT : None
7 ; See HSCP() for format of output array
8 ;NOTES : All input is assumed to exist (no error checking)
9 ;
10 N CODE,FMDATE,TYPE,DOCTOR,PRIORITY
11 N INVDATE,NODE,REQPTR,TYPEPTR,TMP
12 ;GET ZERO NODE OF 2507 EXAM
13 S NODE=$G(^DVB(396.4,PTR,0))
14 ;GET INFO OFF OF NODE
15 S REQPTR=+$P(NODE,"^",2)
16 S TYPEPTR=+$P(NODE,"^",3)
17 S FMDATE=+$P(NODE,"^",6)
18 S DOCTOR=$P(NODE,"^",7)
19 S:(DOCTOR="") DOCTOR="UNKNOWN"
20 ;GET PRIORITY FROM ZERO NODE OF 2507 REQUEST
21 S NODE=$G(^DVB(396.3,REQPTR,0))
22 S TMP=$P(NODE,"^",10)
23 ;CONVERT PRIORITY TO EXTERNAL FORMAT
24 S PRIORITY="UNKNOWN"
25 S:(TMP="T") PRIORITY="TERMINAL"
26 S:(TMP="P") PRIORITY="POS"
27 S:(TMP="OS") PRIORITY="ORIGINAL SC"
28 S:(TMP="ON") PRIORITY="ORIGINAL NSC"
29 S:(TMP="I") PRIORITY="INCREASE"
30 S:(TMP="R") PRIORITY="REVIEW"
31 S:(TMP="OTR") PRIORITY="OTHER"
32 S:(TMP="E") PRIORITY="INSUFFICIENT EXAM"
33 ;CONVERT EXAM TYPE TO EXTERNAL FORMAT
34 S TYPE=$P($G(^DVB(396.6,TYPEPTR,0)),"^",1)
35 S:('TYPEPTR) TYPE="UNKNOWN"
36 ;DETERMINE CODE (BASED ON TRANSFER OUT/IN DATES)
37 S NODE=$G(^DVB(396.4,PTR,"TRAN"))
38 ;DONE AT LOCAL FACILITY
39 S CODE=1
40 ;DONE AT REMOTE FACILITY
41 S:($P(NODE,"^",1)'="") CODE=2
42 ;DONE AT LOCAL FACILITY FOR REMOTE FACILITY
43 S:($P(NODE,"^",4)'="") CODE=3
44 ;CALCULATE INVERSE EXAM DATE
45 S INVDATE=9999999-FMDATE
46 ;PUT INFO INTO GLOBAL
47 S @ARR@(INVDATE,TYPEPTR,0)=CODE_"^"_FMDATE_"^"_TYPE_"^"_DOCTOR_"^"_PRIORITY
48 Q
49OUTRES(PTR,ARR) ;SET NODE 'RES' OF OUTPUT
50 ;INPUT : PTR - Pointer to 2507 EXAM file (#396.4)
51 ; ARR - Where to place output (full global reference)
52 ;OUTPUT : None
53 ; See HSCP^DVBCHS0() for format of output array
54 ;NOTES : All input is assumed to exist (no error checking)
55 ;
56 N LINE,LINES,INVDATE,FMDATE,TYPEPTR,NODE
57 ;GET EXAM DATE & TYPE
58 S NODE=$G(^DVB(396.4,PTR,0))
59 S TYPEPTR=+$P(NODE,"^",3)
60 S FMDATE=+$P(NODE,"^",6)
61 ;CALCULATE INVERSE EXAM DATE
62 S INVDATE=9999999-FMDATE
63 ;PUT RESULTS INTO GLOBAL
64 S LINE=0,LINES=1
65 F S LINE=+$O(^DVB(396.4,PTR,"RES",LINE)) Q:('LINE) D
66 .S @ARR@(INVDATE,TYPEPTR,"RES",LINES)=$G(^DVB(396.4,PTR,"RES",LINE,0))
67 .S LINES=LINES+1
68 ;PUT NUMBER OF LINES INFO INTO GLOBAL
69 S @ARR@(INVDATE,TYPEPTR,"RES",0)=LINES-1
70 Q
Note: See TracBrowser for help on using the repository browser.