HDISVF01 ;BPFO/JRP - FILE UTILITIES/API;12/20/2004 ; 07 Mar 2005 9:53 AM
;;1.0;HEALTH DATA & INFORMATICS;**1**;Feb 22, 2005
;
;---- Begin HDIS VUID IMPLEMENTATION STATUS file (#7118.25) APIs ----
;
GETSTAT(FILE,FIELD,DATE,FAC,DOMAIN,TYPE) ;Get file/field implementation status
; Input : FILE - File number
; FIELD - Field number (defaults to .01)
; DATE - FileMan date/time to return status for (optional)
; (defaults to NOW)
; FAC - Facility number (optional) (defaults to current)
; DOMAIN - Domain/IP address (optional) (defaults to current)
; TYPE - Type of system (optional) (defaults to current)
; 0 = Test 1 = Production
;Output : StatusCode ^ StatusPointer ^ StatusDate
; Notes : Values for "not started" status and no date are returned
; on bad input or if no entry is found
; : If time is not included with the date, the last status
; for the given day is returned
; : If more than one entry for the same date/time is found, the
; higher entry number is returned
N IEN,STATCODE,STATPTR,STATDT,NOTYET,FFPTR,SYSPTR,X
;Calculate output for bad input
S STATCODE=0
S X=$$GETIEN^HDISVF06(STATCODE,+$$GETTYPE^HDISVF02(),.STATPTR)
S NOTYET=STATCODE_"^"_STATPTR_"^"
;Check input
S FILE=+$G(FILE)
I 'FILE Q NOTYET
S FIELD=+$G(FIELD)
I 'FIELD S FIELD=.01
S DATE=+$G(DATE)
I 'DATE S DATE=$$NOW^XLFDT()
I '$P(DATE,".",2) S $P(DATE,".",2)=24
S FAC=+$G(FAC)
I 'FAC S FAC=$$FACNUM()
S DOMAIN=$G(DOMAIN)
I DOMAIN="" S DOMAIN=$G(^XMB("NETNAME"))
S TYPE=$G(TYPE)
I TYPE="" S TYPE=$$PROD^XUPROD()
I ('FAC)!(DOMAIN="")!(TYPE="") Q NOTYET
;Get pointers
I '$$FINDSYS^HDISVF07(DOMAIN,FAC,TYPE,1,.SYSPTR) Q NOTYET
I '$$GETIEN^HDISVF05(FILE,FIELD,.FFPTR) Q NOTYET
;Get status date/time closest to input date/time
S DATE=DATE+.0000001
S STATDT=+$O(^HDISF(7118.25,"AFAC",SYSPTR,FFPTR,DATE),-1)
I 'STATDT Q NOTYET
;Build list of entry numbers with found status date/time
K IEN
S STATPTR=0
F S STATPTR=+$O(^HDISF(7118.25,"AFAC",SYSPTR,FFPTR,STATDT,STATPTR)) Q:'STATPTR D
.S IEN=0
.F S IEN=+$O(^HDISF(7118.25,"AFAC",SYSPTR,FFPTR,STATDT,STATPTR,IEN)) Q:'IEN D
..S IEN(IEN)=STATPTR
;Get last entry number
S IEN=+$O(IEN(""),-1)
I 'IEN Q NOTYET
;Build output
S STATPTR=IEN(IEN)
S X=$$GETCODE^HDISVF06(STATPTR,.STATCODE)
Q STATCODE_"^"_STATPTR_"^"_STATDT
;
SETSTAT(FILE,FIELD,CODE,DATE,STTYPE,FAC,DOMAIN,SYTYPE) ;Set file/field implementation status
; Input : FILE - File number
; FIELD - Field number (defaults to .01)
; CODE - Status code to set (defaults to "not started")
; DATE - FileMan date/time to return status for (optional)
; (defaults to NOW)
; STTYPE - Type of status code being used (optional)
; 1 = Client (default) 2 = Server
; FAC - Facility number (optional) (defaults to current)
; DOMAIN - Domain/IP address (optional) (defaults to current)
; SYTYPE - Type of system (optional) (defaults to current)
; 0 = Test 1 = Production
;Output : None
; Notes : If time is not included with the date, 1 second past
; midnight will be used as the time
; : If an entry for the given file/field and date/time already
; exists, a new entry will still be added
N FFPTR,SYSPTR
;Check input
S FILE=+$G(FILE)
I 'FILE Q
S FIELD=+$G(FIELD)
I 'FIELD S FIELD=.01
S CODE=+$G(CODE)
S DATE=+$G(DATE)
I 'DATE S DATE=$$NOW^XLFDT()
I '$P(DATE,".",2) S $P(DATE,".",2)="000001"
S STTYPE=+$G(STTYPE)
I ('STTYPE)!(STTYPE<1)!(STTYPE>2) S STTYPE=1
S FAC=+$G(FAC)
I 'FAC S FAC=$$FACNUM()
S DOMAIN=$G(DOMAIN)
I DOMAIN="" S DOMAIN=$G(^XMB("NETNAME"))
S SYTYPE=$G(SYTYPE)
I SYTYPE="" S SYTYPE=$$PROD^XUPROD()
I ('FAC)!(DOMAIN="")!(SYTYPE="") Q
;Get pointers
I '$$FINDSYS^HDISVF07(DOMAIN,FAC,SYTYPE,1,.SYSPTR) Q
I '$$GETIEN^HDISVF05(FILE,FIELD,.FFPTR) Q
;Create entry
D ADDSTAT(FFPTR,SYSPTR,CODE,STTYPE,DATE)
Q
;
SCREEN(FILE,FIELD,DATE) ;Apply screening logic to file/field ?
; Input : FILE - File number
; FIELD - Field number (defaults to .01)
; DATE - FileMan date/time to check against (optional)
; (defaults to NOW)
;Output : Flag indicating if screening logic should be applied
; 0 = Don't screen entries during selection
; 1 = Screen entries during selection
; Notes : 0 (don't screen) is returned on bad input
; : If time is not included with the date, the last status
; for the given day is returned
N SCREEN,STAT
S SCREEN=0
S FILE=+$G(FILE)
I 'FILE Q SCREEN
S FIELD=+$G(FIELD)
I 'FIELD S FIELD=.01
S DATE=+$G(DATE)
I 'DATE S DATE=$$NOW^XLFDT()
S STAT=$$GETSTAT(FILE,FIELD,DATE)
I +STAT=6 S SCREEN=1
Q SCREEN
;
ADDSTAT(FFPTR,SYSPTR,CODE,TYPE,DATE) ;Set file/field implementation status
; Input : FFPTR - Pointer to HDIS FILE/FIELD file (#7115.6)
; SYSPTR - Pointer to HDIS SYSTEM file (#7118.21)
; CODE - Status code to set (defaults to "not started")
; TYPE - Type of status code being used (optional)
; 1 = Client (default) 2 = Server
; DATE - FileMan date/time to return status for (optional)
; (defaults to NOW)
;Ouput : None
; Notes : If time is not included with the date, 1 second past
; midnight will be used as the time
; : If an entry for the given file/field and date/time already
; exists, a new entry will still be added
; : Call assumes that FFPTR and SYSPTR are valid
N STATPTR,HDISFDA,HDISIEN,HDISMSG,IENS
;Check input
S FFPTR=+$G(FFPTR)
I 'FFPTR Q
S SYSPTR=+$G(SYSPTR)
I 'SYSPTR Q
S CODE=+$G(CODE)
S DATE=+$G(DATE)
I 'DATE S DATE=$$NOW^XLFDT()
I '$P(DATE,".",2) S $P(DATE,".",2)="000001"
S TYPE=+$G(TYPE)
I ('TYPE)!(TYPE<1)!(TYPE>2) S TYPE=1
;Get pointer to status
I '$$GETIEN^HDISVF06(CODE,TYPE,.STATPTR) Q
;Create entry
S IENS="+1,"
S HDISFDA(7118.25,IENS,.01)=SYSPTR
S HDISFDA(7118.25,IENS,.02)=FFPTR
S HDISFDA(7118.25,IENS,.03)=STATPTR
S HDISFDA(7118.25,IENS,.04)=DATE
D UPDATE^DIE("","HDISFDA","HDISIEN","HDISMSG")
Q
;
;---- End HDIS VUID IMPLEMENTATION STATUS file (#7118.25) APIs ----
;
FACPTR(FACNUM) ;Return pointer to INSTITUTION file (#4) for facility number
; Input : FACNUM - Facility number (optional) (defaults to current)
;Output : Pointer to INSTITUTION file (#4)
; Notes : NULL ("") is returned if an entry can not be found
N FACPTR
S FACNUM=$G(FACNUM)
I 'FACNUM D Q FACPTR
.S FACPTR=+$$SITE^VASITE()
.I FACPTR<1 S FACPTR=""
S FACPTR=$$LKUP^XUAF4(FACNUM)
I 'FACPTR S FACPTR=""
Q FACPTR
;
FACNUM(FACPTR) ;Return facility number
; Input : FACPTR - Pointer to INSTITUTION file (#4) (optional)
; (default to current location)
;Output : Facility number
; Null ("") returned if facility number couldn't be determined
N FACNUM
S FACPTR=$G(FACPTR)
I 'FACPTR D Q FACNUM
.S FACNUM=$P($$SITE^VASITE(),"^",3)
.I FACNUM<1 S FACNUM=""
S FACNUM=$P($$NS^XUAF4(FACPTR),"^",2)
I FACNUM<1 S FACNUM=""
Q FACNUM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHDISVF01 7302 printed Sep 23, 2025@19:32:52 Page 2
HDISVF01 ;BPFO/JRP - FILE UTILITIES/API;12/20/2004 ; 07 Mar 2005 9:53 AM
+1 ;;1.0;HEALTH DATA & INFORMATICS;**1**;Feb 22, 2005
+2 ;
+3 ;---- Begin HDIS VUID IMPLEMENTATION STATUS file (#7118.25) APIs ----
+4 ;
GETSTAT(FILE,FIELD,DATE,FAC,DOMAIN,TYPE) ;Get file/field implementation status
+1 ; Input : FILE - File number
+2 ; FIELD - Field number (defaults to .01)
+3 ; DATE - FileMan date/time to return status for (optional)
+4 ; (defaults to NOW)
+5 ; FAC - Facility number (optional) (defaults to current)
+6 ; DOMAIN - Domain/IP address (optional) (defaults to current)
+7 ; TYPE - Type of system (optional) (defaults to current)
+8 ; 0 = Test 1 = Production
+9 ;Output : StatusCode ^ StatusPointer ^ StatusDate
+10 ; Notes : Values for "not started" status and no date are returned
+11 ; on bad input or if no entry is found
+12 ; : If time is not included with the date, the last status
+13 ; for the given day is returned
+14 ; : If more than one entry for the same date/time is found, the
+15 ; higher entry number is returned
+16 NEW IEN,STATCODE,STATPTR,STATDT,NOTYET,FFPTR,SYSPTR,X
+17 ;Calculate output for bad input
+18 SET STATCODE=0
+19 SET X=$$GETIEN^HDISVF06(STATCODE,+$$GETTYPE^HDISVF02(),.STATPTR)
+20 SET NOTYET=STATCODE_"^"_STATPTR_"^"
+21 ;Check input
+22 SET FILE=+$GET(FILE)
+23 IF 'FILE
QUIT NOTYET
+24 SET FIELD=+$GET(FIELD)
+25 IF 'FIELD
SET FIELD=.01
+26 SET DATE=+$GET(DATE)
+27 IF 'DATE
SET DATE=$$NOW^XLFDT()
+28 IF '$PIECE(DATE,".",2)
SET $PIECE(DATE,".",2)=24
+29 SET FAC=+$GET(FAC)
+30 IF 'FAC
SET FAC=$$FACNUM()
+31 SET DOMAIN=$GET(DOMAIN)
+32 IF DOMAIN=""
SET DOMAIN=$GET(^XMB("NETNAME"))
+33 SET TYPE=$GET(TYPE)
+34 IF TYPE=""
SET TYPE=$$PROD^XUPROD()
+35 IF ('FAC)!(DOMAIN="")!(TYPE="")
QUIT NOTYET
+36 ;Get pointers
+37 IF '$$FINDSYS^HDISVF07(DOMAIN,FAC,TYPE,1,.SYSPTR)
QUIT NOTYET
+38 IF '$$GETIEN^HDISVF05(FILE,FIELD,.FFPTR)
QUIT NOTYET
+39 ;Get status date/time closest to input date/time
+40 SET DATE=DATE+.0000001
+41 SET STATDT=+$ORDER(^HDISF(7118.25,"AFAC",SYSPTR,FFPTR,DATE),-1)
+42 IF 'STATDT
QUIT NOTYET
+43 ;Build list of entry numbers with found status date/time
+44 KILL IEN
+45 SET STATPTR=0
+46 FOR
SET STATPTR=+$ORDER(^HDISF(7118.25,"AFAC",SYSPTR,FFPTR,STATDT,STATPTR))
if 'STATPTR
QUIT
Begin DoDot:1
+47 SET IEN=0
+48 FOR
SET IEN=+$ORDER(^HDISF(7118.25,"AFAC",SYSPTR,FFPTR,STATDT,STATPTR,IEN))
if 'IEN
QUIT
Begin DoDot:2
+49 SET IEN(IEN)=STATPTR
End DoDot:2
End DoDot:1
+50 ;Get last entry number
+51 SET IEN=+$ORDER(IEN(""),-1)
+52 IF 'IEN
QUIT NOTYET
+53 ;Build output
+54 SET STATPTR=IEN(IEN)
+55 SET X=$$GETCODE^HDISVF06(STATPTR,.STATCODE)
+56 QUIT STATCODE_"^"_STATPTR_"^"_STATDT
+57 ;
SETSTAT(FILE,FIELD,CODE,DATE,STTYPE,FAC,DOMAIN,SYTYPE) ;Set file/field implementation status
+1 ; Input : FILE - File number
+2 ; FIELD - Field number (defaults to .01)
+3 ; CODE - Status code to set (defaults to "not started")
+4 ; DATE - FileMan date/time to return status for (optional)
+5 ; (defaults to NOW)
+6 ; STTYPE - Type of status code being used (optional)
+7 ; 1 = Client (default) 2 = Server
+8 ; FAC - Facility number (optional) (defaults to current)
+9 ; DOMAIN - Domain/IP address (optional) (defaults to current)
+10 ; SYTYPE - Type of system (optional) (defaults to current)
+11 ; 0 = Test 1 = Production
+12 ;Output : None
+13 ; Notes : If time is not included with the date, 1 second past
+14 ; midnight will be used as the time
+15 ; : If an entry for the given file/field and date/time already
+16 ; exists, a new entry will still be added
+17 NEW FFPTR,SYSPTR
+18 ;Check input
+19 SET FILE=+$GET(FILE)
+20 IF 'FILE
QUIT
+21 SET FIELD=+$GET(FIELD)
+22 IF 'FIELD
SET FIELD=.01
+23 SET CODE=+$GET(CODE)
+24 SET DATE=+$GET(DATE)
+25 IF 'DATE
SET DATE=$$NOW^XLFDT()
+26 IF '$PIECE(DATE,".",2)
SET $PIECE(DATE,".",2)="000001"
+27 SET STTYPE=+$GET(STTYPE)
+28 IF ('STTYPE)!(STTYPE<1)!(STTYPE>2)
SET STTYPE=1
+29 SET FAC=+$GET(FAC)
+30 IF 'FAC
SET FAC=$$FACNUM()
+31 SET DOMAIN=$GET(DOMAIN)
+32 IF DOMAIN=""
SET DOMAIN=$GET(^XMB("NETNAME"))
+33 SET SYTYPE=$GET(SYTYPE)
+34 IF SYTYPE=""
SET SYTYPE=$$PROD^XUPROD()
+35 IF ('FAC)!(DOMAIN="")!(SYTYPE="")
QUIT
+36 ;Get pointers
+37 IF '$$FINDSYS^HDISVF07(DOMAIN,FAC,SYTYPE,1,.SYSPTR)
QUIT
+38 IF '$$GETIEN^HDISVF05(FILE,FIELD,.FFPTR)
QUIT
+39 ;Create entry
+40 DO ADDSTAT(FFPTR,SYSPTR,CODE,STTYPE,DATE)
+41 QUIT
+42 ;
SCREEN(FILE,FIELD,DATE) ;Apply screening logic to file/field ?
+1 ; Input : FILE - File number
+2 ; FIELD - Field number (defaults to .01)
+3 ; DATE - FileMan date/time to check against (optional)
+4 ; (defaults to NOW)
+5 ;Output : Flag indicating if screening logic should be applied
+6 ; 0 = Don't screen entries during selection
+7 ; 1 = Screen entries during selection
+8 ; Notes : 0 (don't screen) is returned on bad input
+9 ; : If time is not included with the date, the last status
+10 ; for the given day is returned
+11 NEW SCREEN,STAT
+12 SET SCREEN=0
+13 SET FILE=+$GET(FILE)
+14 IF 'FILE
QUIT SCREEN
+15 SET FIELD=+$GET(FIELD)
+16 IF 'FIELD
SET FIELD=.01
+17 SET DATE=+$GET(DATE)
+18 IF 'DATE
SET DATE=$$NOW^XLFDT()
+19 SET STAT=$$GETSTAT(FILE,FIELD,DATE)
+20 IF +STAT=6
SET SCREEN=1
+21 QUIT SCREEN
+22 ;
ADDSTAT(FFPTR,SYSPTR,CODE,TYPE,DATE) ;Set file/field implementation status
+1 ; Input : FFPTR - Pointer to HDIS FILE/FIELD file (#7115.6)
+2 ; SYSPTR - Pointer to HDIS SYSTEM file (#7118.21)
+3 ; CODE - Status code to set (defaults to "not started")
+4 ; TYPE - Type of status code being used (optional)
+5 ; 1 = Client (default) 2 = Server
+6 ; DATE - FileMan date/time to return status for (optional)
+7 ; (defaults to NOW)
+8 ;Ouput : None
+9 ; Notes : If time is not included with the date, 1 second past
+10 ; midnight will be used as the time
+11 ; : If an entry for the given file/field and date/time already
+12 ; exists, a new entry will still be added
+13 ; : Call assumes that FFPTR and SYSPTR are valid
+14 NEW STATPTR,HDISFDA,HDISIEN,HDISMSG,IENS
+15 ;Check input
+16 SET FFPTR=+$GET(FFPTR)
+17 IF 'FFPTR
QUIT
+18 SET SYSPTR=+$GET(SYSPTR)
+19 IF 'SYSPTR
QUIT
+20 SET CODE=+$GET(CODE)
+21 SET DATE=+$GET(DATE)
+22 IF 'DATE
SET DATE=$$NOW^XLFDT()
+23 IF '$PIECE(DATE,".",2)
SET $PIECE(DATE,".",2)="000001"
+24 SET TYPE=+$GET(TYPE)
+25 IF ('TYPE)!(TYPE<1)!(TYPE>2)
SET TYPE=1
+26 ;Get pointer to status
+27 IF '$$GETIEN^HDISVF06(CODE,TYPE,.STATPTR)
QUIT
+28 ;Create entry
+29 SET IENS="+1,"
+30 SET HDISFDA(7118.25,IENS,.01)=SYSPTR
+31 SET HDISFDA(7118.25,IENS,.02)=FFPTR
+32 SET HDISFDA(7118.25,IENS,.03)=STATPTR
+33 SET HDISFDA(7118.25,IENS,.04)=DATE
+34 DO UPDATE^DIE("","HDISFDA","HDISIEN","HDISMSG")
+35 QUIT
+36 ;
+37 ;---- End HDIS VUID IMPLEMENTATION STATUS file (#7118.25) APIs ----
+38 ;
FACPTR(FACNUM) ;Return pointer to INSTITUTION file (#4) for facility number
+1 ; Input : FACNUM - Facility number (optional) (defaults to current)
+2 ;Output : Pointer to INSTITUTION file (#4)
+3 ; Notes : NULL ("") is returned if an entry can not be found
+4 NEW FACPTR
+5 SET FACNUM=$GET(FACNUM)
+6 IF 'FACNUM
Begin DoDot:1
+7 SET FACPTR=+$$SITE^VASITE()
+8 IF FACPTR<1
SET FACPTR=""
End DoDot:1
QUIT FACPTR
+9 SET FACPTR=$$LKUP^XUAF4(FACNUM)
+10 IF 'FACPTR
SET FACPTR=""
+11 QUIT FACPTR
+12 ;
FACNUM(FACPTR) ;Return facility number
+1 ; Input : FACPTR - Pointer to INSTITUTION file (#4) (optional)
+2 ; (default to current location)
+3 ;Output : Facility number
+4 ; Null ("") returned if facility number couldn't be determined
+5 NEW FACNUM
+6 SET FACPTR=$GET(FACPTR)
+7 IF 'FACPTR
Begin DoDot:1
+8 SET FACNUM=$PIECE($$SITE^VASITE(),"^",3)
+9 IF FACNUM<1
SET FACNUM=""
End DoDot:1
QUIT FACNUM
+10 SET FACNUM=$PIECE($$NS^XUAF4(FACPTR),"^",2)
+11 IF FACNUM<1
SET FACNUM=""
+12 QUIT FACNUM
