source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCHS2.m@ 1384

DVBCHS2 ;ALB/JRP - C & P EXTRACT FOR HEALTH SUMMARY (CONT);11-JAN-95
 ;;2.7;AMIE;;Apr 10, 1995
OUT1(PTR,ARR) ;SET NODE ONE 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 CODE,NODE,LOCPTR,LOCATION,OWNPTR,OWNER,OUTPTR
 N TYPEPTR,FMDATE,REQPTR,OUTDOM,INVDATE
 ;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
 ;GET ROUTING LOCATION
 S REQPTR=+$P($G(^DVB(396.4,PTR,0)),"^",2)
 S LOCPTR=+$P($G(^DVB(396.3,REQPTR,1)),"^",4)
 S LOCATION=$P($G(^DG(40.8,LOCPTR,0)),"^",1)
 S:('LOCPTR) LOCATION="UNKNOWN"
 ;DEFAULT REMOTE DOMAINS TO N/A
 S OWNER="N/A"
 S OUTDOM="N/A"
 ;EXAM DONE REMOTELY
 I (CODE=2) D
 .S OUTPTR=+$P($G(^DVB(396.4,PTR,"TRAN")),"^",3)
 .S OUTDOM=$P($G(^DIC(4.2,OUTPTR,0)),"^",1)
 .S:('OUTPTR) OUTDOM="UNKNOWN"
 ;EXAM DONE FOR REMOTE FACILITY
 I (CODE=3) D
 .S OWNPTR=+$P($G(^DVB(396.3,REQPTR,0)),"^",22)
 .S OWNER=$P($G(^DIC(4.2,OWNPTR,0)),"^",1)
 .S:('OWNPTR) OWNER="UNKNOWN"
 ;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 INFO INTO GLOBAL
 S @ARR@(INVDATE,TYPEPTR,1)=LOCATION_"^"_OWNER_"^"_OUTDOM
 Q
OUT2(PTR,ARR) ;SET NODE TWO 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 NODE,CODE,TYPEPTR,FMDATE,INVDATE
 N STATUS,APPRVBY,APPRVDTE,REQPTR
 ;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
 ;GET INFO FROM REQUEST
 S REQPTR=+$P($G(^DVB(396.4,PTR,0)),"^",2)
 ;GET APPROVAL INFO
 S NODE=$G(^DVB(396.3,REQPTR,1))
 S APPRVBY=$P(NODE,"^",5)
 S APPRVDTE=+$P(NODE,"^",6)
 ;DETERMINE STATUS
 S TMP=$P($G(^DVB(396.3,REQPTR,0)),"^",18)
 S STATUS="UNKNOWN"
 S:(TMP="N") STATUS="NEW",APPRVBY="N/A"
 S:(TMP="P") STATUS="PENDING, REPORTED",APPRVBY="N/A"
 S:(TMP="S") STATUS="PENDING SCHEDULED",APPRVBY="N/A"
 S:(TMP="R") STATUS="RELEASED TO RO, NOT PRINTED"
 S:(TMP="C") STATUS="COMPLETED, PRINTED BY RO"
 S:(TMP="X") STATUS="CANCELLED BY MAS",APPRVBY="N/A"
 S:(TMP="RX") STATUS="CANCELLED BY RO",APPRVBY="N/A"
 S:(TMP="T") STATUS="TRANSCRIBED",APPRVBY="N/A"
 S:(TMP="NT") STATUS="NEW, TRANSFERRED IN",APPRVBY="N/A"
 S:(TMP="CT") STATUS="COMPLETED, TRANSFERRED OUT"
 S:(STATUS="UNKNOWN") APPRVBY="N/A"
 ;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 INFO INTO GLOBAL
 S @ARR@(INVDATE,TYPEPTR,2)=STATUS_"^"_APPRVBY_"^"_APPRVDTE
 Q