DVBCHS0 ;ALB/JRP - C & P EXTRACT FOR HEALTH SUMMARY;11-JAN-95
;;2.7;AMIE;**193**;Apr 10, 1995;Build 84
HSCP(PATPTR,INVBEGDT,INVENDDT,OUTCODE,ARRAY) ;MAIN ENTRY POINT
;INPUT : PATPTR - Pointer to PATIENT file (#2)
; INVBEGDT - Beginning date in inverse FileMan format
; - Defaults to one year before today
; INVENDDT - Ending date in inverse FileMan format
; - Defaults to today
; OUTCODE - Flag indicating which optional nodes to return
; 0 = Do not return any optional nodes
; 1 = Node 1 should also be returned
; 2 = Node 2 should also be returned
; 3 = Nodes 1 & 2 should also be returned (default)
; ARRAY - Where to store output (full global reference)
; - Defaults to ^TMP("DVBC",$J)
;
;OUTPUT : None
; ARRAY(InvExDt,Type,0) = Code ^ DATE OF EXAM [.06]
; ^ EXAM TYPE [.03] ^ EXAMINING PHYSICIAN [.07]
; ^ PRIORITY OF EXAM [396.3;9]
; --> ARRAY(InvExDt,Type,1) = ROUTING LOCATION [396.3;24]
; ^ OWNER DOMAIN [396.3;28] ^ TRANSFERRED OUT TO [62]
; --> ARRAY(InvExDt,Type,2) = REQUEST STATUS [396.3;17]
; ^ APPROVED BY [396.3;25] ^ APPROVAL DATE/TIME [396.3;26]
; ARRAY(InvExDt,Type,"RES",0) = Number of lines in EXAM RESULTS
; ARRAY(InvExDt,Type,"RES",X) = Line X of EXAM RESULTS [70]
;
; Subscripts:
; InvExDt - Inverse FileMan date of DATE OF EXAM [.06]
; Type - Poiner value of EXAM TYPE [.03]
;
; Code used as follows:
; 1 = Exam was performed locally
; 2 = Exam was performed by another facility
; 3 = Exam was performed locally for another facility
;
; All dates will be in the FileMan format
;
; With the exception of dates, 'N/A' (not applicable) and 'UNKNOWN'
; will be used for field values when appropriate
;
; Optional nodes are marked by an arrow (-->)
;
;NOTES : Output array will be initialized (KILLed)
; : Information for an exam is only returned when
; 1. The exam status is COMPLETED
; 2. The status of the request containing the exam is
; a) RELEASED TO RO, NOT PRINTED
; b) COMPLETED, PRINTED BY RO
; c) COMPLETED, TRANSFERRED OUT
;
;
;CHECK INPUT/SET DEFAULTS
Q:('$D(^DPT((+$G(PATPTR)),0)))
S INVBEGDT=+$G(INVBEGDT)
S:('INVBEGDT) INVBEGDT=9999999-(DT-10000)
S INVENDDT=+$G(INVENDDT)
S:('INVENDDT) INVENDDT=9999999-DT
S OUTCODE=$G(OUTCODE)
S:((OUTCODE="")!(OUTCODE>3)!(OUTCODE<0)) OUTCODE=3
S:($G(ARRAY)="") ARRAY="^TMP(""DVBC"",$J)"
;KILL OUTPUT ARRAY
K @ARRAY
;DECLARE VARIABLES
N BEGDATE,ENDDATE,TYPEPTR,EXAMPTR,TMP,NODE0
;CONVERT INVERSE DATES TO NORMAL DATES
S BEGDATE=9999999-INVBEGDT
S ENDDATE=9999999-INVENDDT
;NO EXAMS ON FILE
Q:('$D(^DVB(396.4,"APS",PATPTR)))
;LOOK FOR COMPLETED EXAMS
S TYPEPTR=0
F S TYPEPTR=+$O(^DVB(396.4,"APS",PATPTR,TYPEPTR)) Q:('TYPEPTR) D
.S EXAMPTR=0
.F S EXAMPTR=+$O(^DVB(396.4,"APS",PATPTR,TYPEPTR,"C",EXAMPTR)) Q:('EXAMPTR) D
..;GET ZERO NODE OF EXAM
..S NODE0=$G(^DVB(396.4,EXAMPTR,0))
..;MAKE SURE EXAM IS WITHIN DATE RANGE
..S TMP=+$P(NODE0,"^",6)
..Q:(('TMP)!(TMP<BEGDATE)!(TMP>ENDDATE))
..;MAKE SURE REQUEST CONTAINING EXAM HAS BEEN RELEASED
..S TMP=+$P(NODE0,"^",2)
..Q:('TMP)
..S TMP=$P($G(^DVB(396.3,TMP,0)),"^",18)
..;AJF ; 2507 Request Status Conversion
..S TMP=$$RSTAT^DVBCUTL8(TMP)
..Q:((TMP'="C")&(TMP'="R")&(TMP'="CT"))
..;SET NODE ZERO OF OUTPUT
..D OUT0^DVBCHS1(EXAMPTR,ARRAY)
..;SET NODE 'RES' OF OUTPUT
..D OUTRES^DVBCHS1(EXAMPTR,ARRAY)
..Q:('OUTCODE)
..;SET NODE ONE OF OUTPUT (OPTIONAL)
..D:((OUTCODE=1)!(OUTCODE=3)) OUT1^DVBCHS2(EXAMPTR,ARRAY)
..;SET NODE TWO OF OUTPUT (OPTIONAL)
..D:((OUTCODE=2)!(OUTCODE=3)) OUT2^DVBCHS2(EXAMPTR,ARRAY)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCHS0 3925 printed Sep 23, 2025@19:20:28 Page 2
DVBCHS0 ;ALB/JRP - C & P EXTRACT FOR HEALTH SUMMARY;11-JAN-95
+1 ;;2.7;AMIE;**193**;Apr 10, 1995;Build 84
HSCP(PATPTR,INVBEGDT,INVENDDT,OUTCODE,ARRAY) ;MAIN ENTRY POINT
+1 ;INPUT : PATPTR - Pointer to PATIENT file (#2)
+2 ; INVBEGDT - Beginning date in inverse FileMan format
+3 ; - Defaults to one year before today
+4 ; INVENDDT - Ending date in inverse FileMan format
+5 ; - Defaults to today
+6 ; OUTCODE - Flag indicating which optional nodes to return
+7 ; 0 = Do not return any optional nodes
+8 ; 1 = Node 1 should also be returned
+9 ; 2 = Node 2 should also be returned
+10 ; 3 = Nodes 1 & 2 should also be returned (default)
+11 ; ARRAY - Where to store output (full global reference)
+12 ; - Defaults to ^TMP("DVBC",$J)
+13 ;
+14 ;OUTPUT : None
+15 ; ARRAY(InvExDt,Type,0) = Code ^ DATE OF EXAM [.06]
+16 ; ^ EXAM TYPE [.03] ^ EXAMINING PHYSICIAN [.07]
+17 ; ^ PRIORITY OF EXAM [396.3;9]
+18 ; --> ARRAY(InvExDt,Type,1) = ROUTING LOCATION [396.3;24]
+19 ; ^ OWNER DOMAIN [396.3;28] ^ TRANSFERRED OUT TO [62]
+20 ; --> ARRAY(InvExDt,Type,2) = REQUEST STATUS [396.3;17]
+21 ; ^ APPROVED BY [396.3;25] ^ APPROVAL DATE/TIME [396.3;26]
+22 ; ARRAY(InvExDt,Type,"RES",0) = Number of lines in EXAM RESULTS
+23 ; ARRAY(InvExDt,Type,"RES",X) = Line X of EXAM RESULTS [70]
+24 ;
+25 ; Subscripts:
+26 ; InvExDt - Inverse FileMan date of DATE OF EXAM [.06]
+27 ; Type - Poiner value of EXAM TYPE [.03]
+28 ;
+29 ; Code used as follows:
+30 ; 1 = Exam was performed locally
+31 ; 2 = Exam was performed by another facility
+32 ; 3 = Exam was performed locally for another facility
+33 ;
+34 ; All dates will be in the FileMan format
+35 ;
+36 ; With the exception of dates, 'N/A' (not applicable) and 'UNKNOWN'
+37 ; will be used for field values when appropriate
+38 ;
+39 ; Optional nodes are marked by an arrow (-->)
+40 ;
+41 ;NOTES : Output array will be initialized (KILLed)
+42 ; : Information for an exam is only returned when
+43 ; 1. The exam status is COMPLETED
+44 ; 2. The status of the request containing the exam is
+45 ; a) RELEASED TO RO, NOT PRINTED
+46 ; b) COMPLETED, PRINTED BY RO
+47 ; c) COMPLETED, TRANSFERRED OUT
+48 ;
+49 ;
+50 ;CHECK INPUT/SET DEFAULTS
+51 if ('$DATA(^DPT((+$GET(PATPTR)),0)))
QUIT
+52 SET INVBEGDT=+$GET(INVBEGDT)
+53 if ('INVBEGDT)
SET INVBEGDT=9999999-(DT-10000)
+54 SET INVENDDT=+$GET(INVENDDT)
+55 if ('INVENDDT)
SET INVENDDT=9999999-DT
+56 SET OUTCODE=$GET(OUTCODE)
+57 if ((OUTCODE="")!(OUTCODE>3)!(OUTCODE<0))
SET OUTCODE=3
+58 if ($GET(ARRAY)="")
SET ARRAY="^TMP(""DVBC"",$J)"
+59 ;KILL OUTPUT ARRAY
+60 KILL @ARRAY
+61 ;DECLARE VARIABLES
+62 NEW BEGDATE,ENDDATE,TYPEPTR,EXAMPTR,TMP,NODE0
+63 ;CONVERT INVERSE DATES TO NORMAL DATES
+64 SET BEGDATE=9999999-INVBEGDT
+65 SET ENDDATE=9999999-INVENDDT
+66 ;NO EXAMS ON FILE
+67 if ('$DATA(^DVB(396.4,"APS",PATPTR)))
QUIT
+68 ;LOOK FOR COMPLETED EXAMS
+69 SET TYPEPTR=0
+70 FOR
SET TYPEPTR=+$ORDER(^DVB(396.4,"APS",PATPTR,TYPEPTR))
if ('TYPEPTR)
QUIT
Begin DoDot:1
+71 SET EXAMPTR=0
+72 FOR
SET EXAMPTR=+$ORDER(^DVB(396.4,"APS",PATPTR,TYPEPTR,"C",EXAMPTR))
if ('EXAMPTR)
QUIT
Begin DoDot:2
+73 ;GET ZERO NODE OF EXAM
+74 SET NODE0=$GET(^DVB(396.4,EXAMPTR,0))
+75 ;MAKE SURE EXAM IS WITHIN DATE RANGE
+76 SET TMP=+$PIECE(NODE0,"^",6)
+77 if (('TMP)!(TMP<BEGDATE)!(TMP>ENDDATE))
QUIT
+78 ;MAKE SURE REQUEST CONTAINING EXAM HAS BEEN RELEASED
+79 SET TMP=+$PIECE(NODE0,"^",2)
+80 if ('TMP)
QUIT
+81 SET TMP=$PIECE($GET(^DVB(396.3,TMP,0)),"^",18)
+82 ;AJF ; 2507 Request Status Conversion
+83 SET TMP=$$RSTAT^DVBCUTL8(TMP)
+84 if ((TMP'="C")&(TMP'="R")&(TMP'="CT"))
QUIT
+85 ;SET NODE ZERO OF OUTPUT
+86 DO OUT0^DVBCHS1(EXAMPTR,ARRAY)
+87 ;SET NODE 'RES' OF OUTPUT
+88 DO OUTRES^DVBCHS1(EXAMPTR,ARRAY)
+89 if ('OUTCODE)
QUIT
+90 ;SET NODE ONE OF OUTPUT (OPTIONAL)
+91 if ((OUTCODE=1)!(OUTCODE=3))
DO OUT1^DVBCHS2(EXAMPTR,ARRAY)
+92 ;SET NODE TWO OF OUTPUT (OPTIONAL)
+93 if ((OUTCODE=2)!(OUTCODE=3))
DO OUT2^DVBCHS2(EXAMPTR,ARRAY)
End DoDot:2
End DoDot:1
+94 QUIT
