DVBCHS1 ;ALB/JRP - C & P EXTRACT FOR HEALTH SUMMARY (CONT);11-JAN-95
 ;;2.7;AMIE;;Apr 10, 1995
OUT0(PTR,ARR) ;SET NODE ZERO OF OUTPUT
 ;INPUT  : PTR - Pointer to 2507 EXAM file (#396.4)
 ;         ARR - Where to place output (full global reference)
 ;OUTPUT : None
 ;         See HSCP() for format of output array
 ;NOTES  : All input is assumed to exist (no error checking)
 ;
 N CODE,FMDATE,TYPE,DOCTOR,PRIORITY
 N INVDATE,NODE,REQPTR,TYPEPTR,TMP
 ;GET ZERO NODE OF 2507 EXAM
 S NODE=$G(^DVB(396.4,PTR,0))
 ;GET INFO OFF OF NODE
 S REQPTR=+$P(NODE,"^",2)
 S TYPEPTR=+$P(NODE,"^",3)
 S FMDATE=+$P(NODE,"^",6)
 S DOCTOR=$P(NODE,"^",7)
 S:(DOCTOR="") DOCTOR="UNKNOWN"
 ;GET PRIORITY FROM ZERO NODE OF 2507 REQUEST
 S NODE=$G(^DVB(396.3,REQPTR,0))
 S TMP=$P(NODE,"^",10)
 ;CONVERT PRIORITY TO EXTERNAL FORMAT
 S PRIORITY="UNKNOWN"
 S:(TMP="T") PRIORITY="TERMINAL"
 S:(TMP="P") PRIORITY="POS"
 S:(TMP="OS") PRIORITY="ORIGINAL SC"
 S:(TMP="ON") PRIORITY="ORIGINAL NSC"
 S:(TMP="I") PRIORITY="INCREASE"
 S:(TMP="R") PRIORITY="REVIEW"
 S:(TMP="OTR") PRIORITY="OTHER"
 S:(TMP="E") PRIORITY="INSUFFICIENT EXAM"
 ;CONVERT EXAM TYPE TO EXTERNAL FORMAT
 S TYPE=$P($G(^DVB(396.6,TYPEPTR,0)),"^",1)
 S:('TYPEPTR) TYPE="UNKNOWN"
 ;DETERMINE CODE (BASED ON TRANSFER OUT/IN DATES)
 S NODE=$G(^DVB(396.4,PTR,"TRAN"))
 ;DONE AT LOCAL FACILITY
 S CODE=1
 ;DONE AT REMOTE FACILITY
 S:($P(NODE,"^",1)'="") CODE=2
 ;DONE AT LOCAL FACILITY FOR REMOTE FACILITY
 S:($P(NODE,"^",4)'="") CODE=3
 ;CALCULATE INVERSE EXAM DATE
 S INVDATE=9999999-FMDATE
 ;PUT INFO INTO GLOBAL
 S @ARR@(INVDATE,TYPEPTR,0)=CODE_"^"_FMDATE_"^"_TYPE_"^"_DOCTOR_"^"_PRIORITY
 Q
OUTRES(PTR,ARR) ;SET NODE 'RES' OF OUTPUT
 ;INPUT  : PTR - Pointer to 2507 EXAM file (#396.4)
 ;         ARR - Where to place output (full global reference)
 ;OUTPUT : None
 ;         See HSCP^DVBCHS0() for format of output array
 ;NOTES  : All input is assumed to exist (no error checking)
 ;
 N LINE,LINES,INVDATE,FMDATE,TYPEPTR,NODE
 ;GET EXAM DATE & TYPE
 S NODE=$G(^DVB(396.4,PTR,0))
 S TYPEPTR=+$P(NODE,"^",3)
 S FMDATE=+$P(NODE,"^",6)
 ;CALCULATE INVERSE EXAM DATE
 S INVDATE=9999999-FMDATE
 ;PUT RESULTS INTO GLOBAL
 S LINE=0,LINES=1
 F  S LINE=+$O(^DVB(396.4,PTR,"RES",LINE)) Q:('LINE)  D
 .S @ARR@(INVDATE,TYPEPTR,"RES",LINES)=$G(^DVB(396.4,PTR,"RES",LINE,0))
 .S LINES=LINES+1
 ;PUT NUMBER OF LINES INFO INTO GLOBAL
 S @ARR@(INVDATE,TYPEPTR,"RES",0)=LINES-1
 Q