| 1 | HDISVF01 ;BPFO/JRP - FILE UTILITIES/API;12/20/2004 ; 07 Mar 2005  9:53 AM | 
|---|
| 2 | ;;1.0;HEALTH DATA & INFORMATICS;**1**;Feb 22, 2005 | 
|---|
| 3 | ; | 
|---|
| 4 | ;---- Begin HDIS VUID IMPLEMENTATION STATUS file (#7118.25) APIs ---- | 
|---|
| 5 | ; | 
|---|
| 6 | GETSTAT(FILE,FIELD,DATE,FAC,DOMAIN,TYPE) ;Get file/field implementation status | 
|---|
| 7 | ; Input : FILE - File number | 
|---|
| 8 | ;         FIELD - Field number (defaults to .01) | 
|---|
| 9 | ;         DATE - FileMan date/time to return status for (optional) | 
|---|
| 10 | ;                (defaults to NOW) | 
|---|
| 11 | ;         FAC - Facility number (optional) (defaults to current) | 
|---|
| 12 | ;         DOMAIN - Domain/IP address (optional) (defaults to current) | 
|---|
| 13 | ;         TYPE - Type of system (optional) (defaults to current) | 
|---|
| 14 | ;                0 = Test     1 = Production | 
|---|
| 15 | ;Output : StatusCode ^ StatusPointer ^ StatusDate | 
|---|
| 16 | ; Notes : Values for "not started" status and no date are returned | 
|---|
| 17 | ;         on bad input or if no entry is found | 
|---|
| 18 | ;       : If time is not included with the date, the last status | 
|---|
| 19 | ;         for the given day is returned | 
|---|
| 20 | ;       : If more than one entry for the same date/time is found, the | 
|---|
| 21 | ;         higher entry number is returned | 
|---|
| 22 | N IEN,STATCODE,STATPTR,STATDT,NOTYET,FFPTR,SYSPTR,X | 
|---|
| 23 | ;Calculate output for bad input | 
|---|
| 24 | S STATCODE=0 | 
|---|
| 25 | S X=$$GETIEN^HDISVF06(STATCODE,+$$GETTYPE^HDISVF02(),.STATPTR) | 
|---|
| 26 | S NOTYET=STATCODE_"^"_STATPTR_"^" | 
|---|
| 27 | ;Check input | 
|---|
| 28 | S FILE=+$G(FILE) | 
|---|
| 29 | I 'FILE Q NOTYET | 
|---|
| 30 | S FIELD=+$G(FIELD) | 
|---|
| 31 | I 'FIELD S FIELD=.01 | 
|---|
| 32 | S DATE=+$G(DATE) | 
|---|
| 33 | I 'DATE S DATE=$$NOW^XLFDT() | 
|---|
| 34 | I '$P(DATE,".",2) S $P(DATE,".",2)=24 | 
|---|
| 35 | S FAC=+$G(FAC) | 
|---|
| 36 | I 'FAC S FAC=$$FACNUM() | 
|---|
| 37 | S DOMAIN=$G(DOMAIN) | 
|---|
| 38 | I DOMAIN="" S DOMAIN=$G(^XMB("NETNAME")) | 
|---|
| 39 | S TYPE=$G(TYPE) | 
|---|
| 40 | I TYPE="" S TYPE=$$PROD^XUPROD() | 
|---|
| 41 | I ('FAC)!(DOMAIN="")!(TYPE="") Q NOTYET | 
|---|
| 42 | ;Get pointers | 
|---|
| 43 | I '$$FINDSYS^HDISVF07(DOMAIN,FAC,TYPE,1,.SYSPTR) Q NOTYET | 
|---|
| 44 | I '$$GETIEN^HDISVF05(FILE,FIELD,.FFPTR) Q NOTYET | 
|---|
| 45 | ;Get status date/time closest to input date/time | 
|---|
| 46 | S DATE=DATE+.0000001 | 
|---|
| 47 | S STATDT=+$O(^HDISF(7118.25,"AFAC",SYSPTR,FFPTR,DATE),-1) | 
|---|
| 48 | I 'STATDT Q NOTYET | 
|---|
| 49 | ;Build list of entry numbers with found status date/time | 
|---|
| 50 | K IEN | 
|---|
| 51 | S STATPTR=0 | 
|---|
| 52 | F  S STATPTR=+$O(^HDISF(7118.25,"AFAC",SYSPTR,FFPTR,STATDT,STATPTR)) Q:'STATPTR  D | 
|---|
| 53 | .S IEN=0 | 
|---|
| 54 | .F  S IEN=+$O(^HDISF(7118.25,"AFAC",SYSPTR,FFPTR,STATDT,STATPTR,IEN)) Q:'IEN  D | 
|---|
| 55 | ..S IEN(IEN)=STATPTR | 
|---|
| 56 | ;Get last entry number | 
|---|
| 57 | S IEN=+$O(IEN(""),-1) | 
|---|
| 58 | I 'IEN Q NOTYET | 
|---|
| 59 | ;Build output | 
|---|
| 60 | S STATPTR=IEN(IEN) | 
|---|
| 61 | S X=$$GETCODE^HDISVF06(STATPTR,.STATCODE) | 
|---|
| 62 | Q STATCODE_"^"_STATPTR_"^"_STATDT | 
|---|
| 63 | ; | 
|---|
| 64 | SETSTAT(FILE,FIELD,CODE,DATE,STTYPE,FAC,DOMAIN,SYTYPE) ;Set file/field implementation status | 
|---|
| 65 | ; Input : FILE - File number | 
|---|
| 66 | ;         FIELD - Field number (defaults to .01) | 
|---|
| 67 | ;         CODE - Status code to set (defaults to "not started") | 
|---|
| 68 | ;         DATE - FileMan date/time to return status for (optional) | 
|---|
| 69 | ;                (defaults to NOW) | 
|---|
| 70 | ;         STTYPE - Type of status code being used (optional) | 
|---|
| 71 | ;                  1 = Client (default)     2 = Server | 
|---|
| 72 | ;         FAC - Facility number (optional) (defaults to current) | 
|---|
| 73 | ;         DOMAIN - Domain/IP address (optional) (defaults to current) | 
|---|
| 74 | ;         SYTYPE - Type of system (optional) (defaults to current) | 
|---|
| 75 | ;                  0 = Test     1 = Production | 
|---|
| 76 | ;Output : None | 
|---|
| 77 | ; Notes : If time is not included with the date, 1 second past | 
|---|
| 78 | ;         midnight will be used as the time | 
|---|
| 79 | ;       : If an entry for the given file/field and date/time already | 
|---|
| 80 | ;         exists, a new entry will still be added | 
|---|
| 81 | N FFPTR,SYSPTR | 
|---|
| 82 | ;Check input | 
|---|
| 83 | S FILE=+$G(FILE) | 
|---|
| 84 | I 'FILE Q | 
|---|
| 85 | S FIELD=+$G(FIELD) | 
|---|
| 86 | I 'FIELD S FIELD=.01 | 
|---|
| 87 | S CODE=+$G(CODE) | 
|---|
| 88 | S DATE=+$G(DATE) | 
|---|
| 89 | I 'DATE S DATE=$$NOW^XLFDT() | 
|---|
| 90 | I '$P(DATE,".",2) S $P(DATE,".",2)="000001" | 
|---|
| 91 | S STTYPE=+$G(STTYPE) | 
|---|
| 92 | I ('STTYPE)!(STTYPE<1)!(STTYPE>2) S STTYPE=1 | 
|---|
| 93 | S FAC=+$G(FAC) | 
|---|
| 94 | I 'FAC S FAC=$$FACNUM() | 
|---|
| 95 | S DOMAIN=$G(DOMAIN) | 
|---|
| 96 | I DOMAIN="" S DOMAIN=$G(^XMB("NETNAME")) | 
|---|
| 97 | S SYTYPE=$G(SYTYPE) | 
|---|
| 98 | I SYTYPE="" S SYTYPE=$$PROD^XUPROD() | 
|---|
| 99 | I ('FAC)!(DOMAIN="")!(SYTYPE="") Q | 
|---|
| 100 | ;Get pointers | 
|---|
| 101 | I '$$FINDSYS^HDISVF07(DOMAIN,FAC,SYTYPE,1,.SYSPTR) Q | 
|---|
| 102 | I '$$GETIEN^HDISVF05(FILE,FIELD,.FFPTR) Q | 
|---|
| 103 | ;Create entry | 
|---|
| 104 | D ADDSTAT(FFPTR,SYSPTR,CODE,STTYPE,DATE) | 
|---|
| 105 | Q | 
|---|
| 106 | ; | 
|---|
| 107 | SCREEN(FILE,FIELD,DATE) ;Apply screening logic to file/field ? | 
|---|
| 108 | ; Input : FILE - File number | 
|---|
| 109 | ;         FIELD - Field number (defaults to .01) | 
|---|
| 110 | ;         DATE - FileMan date/time to check against (optional) | 
|---|
| 111 | ;                (defaults to NOW) | 
|---|
| 112 | ;Output : Flag indicating if screening logic should be applied | 
|---|
| 113 | ;         0 = Don't screen entries during selection | 
|---|
| 114 | ;         1 = Screen entries during selection | 
|---|
| 115 | ; Notes : 0 (don't screen) is returned on bad input | 
|---|
| 116 | ;       : If time is not included with the date, the last status | 
|---|
| 117 | ;         for the given day is returned | 
|---|
| 118 | N SCREEN,STAT | 
|---|
| 119 | S SCREEN=0 | 
|---|
| 120 | S FILE=+$G(FILE) | 
|---|
| 121 | I 'FILE Q SCREEN | 
|---|
| 122 | S FIELD=+$G(FIELD) | 
|---|
| 123 | I 'FIELD S FIELD=.01 | 
|---|
| 124 | S DATE=+$G(DATE) | 
|---|
| 125 | I 'DATE S DATE=$$NOW^XLFDT() | 
|---|
| 126 | S STAT=$$GETSTAT(FILE,FIELD,DATE) | 
|---|
| 127 | I +STAT=6 S SCREEN=1 | 
|---|
| 128 | Q SCREEN | 
|---|
| 129 | ; | 
|---|
| 130 | ADDSTAT(FFPTR,SYSPTR,CODE,TYPE,DATE) ;Set file/field implementation status | 
|---|
| 131 | ; Input : FFPTR - Pointer to HDIS FILE/FIELD file (#7115.6) | 
|---|
| 132 | ;         SYSPTR - Pointer to HDIS SYSTEM file (#7118.21) | 
|---|
| 133 | ;         CODE - Status code to set (defaults to "not started") | 
|---|
| 134 | ;         TYPE - Type of status code being used (optional) | 
|---|
| 135 | ;                1 = Client (default)     2 = Server | 
|---|
| 136 | ;         DATE - FileMan date/time to return status for (optional) | 
|---|
| 137 | ;                (defaults to NOW) | 
|---|
| 138 | ;Ouput : None | 
|---|
| 139 | ; Notes : If time is not included with the date, 1 second past | 
|---|
| 140 | ;         midnight will be used as the time | 
|---|
| 141 | ;       : If an entry for the given file/field and date/time already | 
|---|
| 142 | ;         exists, a new entry will still be added | 
|---|
| 143 | ;       : Call assumes that FFPTR and SYSPTR are valid | 
|---|
| 144 | N STATPTR,HDISFDA,HDISIEN,HDISMSG,IENS | 
|---|
| 145 | ;Check input | 
|---|
| 146 | S FFPTR=+$G(FFPTR) | 
|---|
| 147 | I 'FFPTR Q | 
|---|
| 148 | S SYSPTR=+$G(SYSPTR) | 
|---|
| 149 | I 'SYSPTR Q | 
|---|
| 150 | S CODE=+$G(CODE) | 
|---|
| 151 | S DATE=+$G(DATE) | 
|---|
| 152 | I 'DATE S DATE=$$NOW^XLFDT() | 
|---|
| 153 | I '$P(DATE,".",2) S $P(DATE,".",2)="000001" | 
|---|
| 154 | S TYPE=+$G(TYPE) | 
|---|
| 155 | I ('TYPE)!(TYPE<1)!(TYPE>2) S TYPE=1 | 
|---|
| 156 | ;Get pointer to status | 
|---|
| 157 | I '$$GETIEN^HDISVF06(CODE,TYPE,.STATPTR) Q | 
|---|
| 158 | ;Create entry | 
|---|
| 159 | S IENS="+1," | 
|---|
| 160 | S HDISFDA(7118.25,IENS,.01)=SYSPTR | 
|---|
| 161 | S HDISFDA(7118.25,IENS,.02)=FFPTR | 
|---|
| 162 | S HDISFDA(7118.25,IENS,.03)=STATPTR | 
|---|
| 163 | S HDISFDA(7118.25,IENS,.04)=DATE | 
|---|
| 164 | D UPDATE^DIE("","HDISFDA","HDISIEN","HDISMSG") | 
|---|
| 165 | Q | 
|---|
| 166 | ; | 
|---|
| 167 | ;---- End HDIS VUID IMPLEMENTATION STATUS file (#7118.25) APIs ---- | 
|---|
| 168 | ; | 
|---|
| 169 | FACPTR(FACNUM) ;Return pointer to INSTITUTION file (#4) for facility number | 
|---|
| 170 | ; Input : FACNUM - Facility number (optional) (defaults to current) | 
|---|
| 171 | ;Output : Pointer to INSTITUTION file (#4) | 
|---|
| 172 | ; Notes : NULL ("") is returned if an entry can not be found | 
|---|
| 173 | N FACPTR | 
|---|
| 174 | S FACNUM=$G(FACNUM) | 
|---|
| 175 | I 'FACNUM D  Q FACPTR | 
|---|
| 176 | .S FACPTR=+$$SITE^VASITE() | 
|---|
| 177 | .I FACPTR<1 S FACPTR="" | 
|---|
| 178 | S FACPTR=$$LKUP^XUAF4(FACNUM) | 
|---|
| 179 | I 'FACPTR S FACPTR="" | 
|---|
| 180 | Q FACPTR | 
|---|
| 181 | ; | 
|---|
| 182 | FACNUM(FACPTR) ;Return facility number | 
|---|
| 183 | ; Input : FACPTR - Pointer to INSTITUTION file (#4) (optional) | 
|---|
| 184 | ;                  (default to current location) | 
|---|
| 185 | ;Output : Facility number | 
|---|
| 186 | ;         Null ("") returned if facility number couldn't be determined | 
|---|
| 187 | N FACNUM | 
|---|
| 188 | S FACPTR=$G(FACPTR) | 
|---|
| 189 | I 'FACPTR D  Q FACNUM | 
|---|
| 190 | .S FACNUM=$P($$SITE^VASITE(),"^",3) | 
|---|
| 191 | .I FACNUM<1 S FACNUM="" | 
|---|
| 192 | S FACNUM=$P($$NS^XUAF4(FACPTR),"^",2) | 
|---|
| 193 | I FACNUM<1 S FACNUM="" | 
|---|
| 194 | Q FACNUM | 
|---|