- 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 Apr 23, 2025@17:58:54 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
