| 1 | DVBCHS1 ;ALB/JRP - C & P EXTRACT FOR HEALTH SUMMARY (CONT);11-JAN-95
|
|---|
| 2 | ;;2.7;AMIE;;Apr 10, 1995
|
|---|
| 3 | OUT0(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
|
|---|
| 49 | OUTRES(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
|
|---|
