| [613] | 1 | HDI1002A ;BPFO/JRP,ALB/RMO - PATCH 2 POST INSTALL;9/27/2005
|
|---|
| 2 | ;;1.0;HEALTH DATA & INFORMATICS;**2**;Feb 22, 2005
|
|---|
| 3 | ;
|
|---|
| 4 | POST ;Main entry point for post-install routine
|
|---|
| 5 | ; Input: None
|
|---|
| 6 | ; All variables set by Kernel for KIDS post-installs
|
|---|
| 7 | ;Output: None
|
|---|
| 8 | N HDIMSG
|
|---|
| 9 | S HDIMSG(1)=" "
|
|---|
| 10 | S HDIMSG(2)="~~~~~~~~~~~~~~~~~~~~"
|
|---|
| 11 | S HDIMSG(3)="Post-Installation (POST^HDI1002A) will now be run"
|
|---|
| 12 | S HDIMSG(4)=" "
|
|---|
| 13 | D MES^XPDUTL(.HDIMSG) K HDIMSG
|
|---|
| 14 | D SCAN
|
|---|
| 15 | S HDIMSG(1)=" "
|
|---|
| 16 | S HDIMSG(2)="Post-Installation ran to completion"
|
|---|
| 17 | S HDIMSG(3)="~~~~~~~~~~~~~~~~~~~~"
|
|---|
| 18 | S HDIMSG(4)=" "
|
|---|
| 19 | D MES^XPDUTL(.HDIMSG) K HDIMSG
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | SCAN ;Scan XTID VUID FOR SET OF CODES file for duplicate statuses
|
|---|
| 23 | ; Input: None
|
|---|
| 24 | ;Output: None
|
|---|
| 25 | ; Notes: Call assumes it is being run within the context of KIDS
|
|---|
| 26 | N COUNT,PTRXTID,XPDIDTOT,TEXT
|
|---|
| 27 | S TEXT(1)=" "
|
|---|
| 28 | S TEXT(2)="Scanning EFFECTIVE DATE/TIME multiple (subfile #8985.11)"
|
|---|
| 29 | S TEXT(3)="of the XTID VUID FOR SET OF CODES file (#8985.1) for"
|
|---|
| 30 | S TEXT(4)="consecutive storage of the same status"
|
|---|
| 31 | S TEXT(5)=" "
|
|---|
| 32 | D MES^XPDUTL(.TEXT)
|
|---|
| 33 | S XPDIDTOT=+$O(^XTID(8985.1,"A"),-1)
|
|---|
| 34 | ;Traverse file
|
|---|
| 35 | S PTRXTID=0
|
|---|
| 36 | F COUNT=1:1 S PTRXTID=+$O(^XTID(8985.1,PTRXTID)) Q:'PTRXTID D
|
|---|
| 37 | .;Show progress through KIDS status bar
|
|---|
| 38 | .I '(COUNT#10) D UPDATE^XPDID(PTRXTID)
|
|---|
| 39 | .;Execute check
|
|---|
| 40 | .D CHECK(PTRXTID)
|
|---|
| 41 | D UPDATE^XPDID(XPDIDTOT)
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | CHECK(PTRXTID) ;Check entry for duplicate statuses
|
|---|
| 45 | ; Input: PTRXTID - Pointer to XTID VUID FOR SET OF CODES file
|
|---|
| 46 | ;Output: None
|
|---|
| 47 | ; Notes: Assumes validity of PTRXTID (internal call)
|
|---|
| 48 | S PTRXTID=+$G(PTRXTID) Q:'PTRXTID
|
|---|
| 49 | N MLTIEN,STAT,STDT,PRVSTAT,PRVSTDT,NODE
|
|---|
| 50 | S (PRVSTAT,PRVSTDT)=""
|
|---|
| 51 | ;Traverse date x-ref of multiple
|
|---|
| 52 | S STDT=0
|
|---|
| 53 | F S STDT=+$O(^XTID(8985.1,PTRXTID,"TERMSTATUS","B",STDT)) Q:'STDT D
|
|---|
| 54 | .S MLTIEN=0
|
|---|
| 55 | .F S MLTIEN=+$O(^XTID(8985.1,PTRXTID,"TERMSTATUS","B",STDT,MLTIEN)) Q:'MLTIEN D
|
|---|
| 56 | ..;Get node/status
|
|---|
| 57 | ..S NODE=$G(^XTID(8985.1,PTRXTID,"TERMSTATUS",MLTIEN,0))
|
|---|
| 58 | ..S STAT=$P(NODE,"^",2)
|
|---|
| 59 | ..;Bad node/status - delete and quit
|
|---|
| 60 | ..I (NODE="")!(NODE="^")!(STAT="") D Q
|
|---|
| 61 | ...D DELETE(PTRXTID,MLTIEN)
|
|---|
| 62 | ..;First status entry - set as previous status and quit
|
|---|
| 63 | ..I PRVSTAT="" D SETPRV Q
|
|---|
| 64 | ..;Same as previous status - delete
|
|---|
| 65 | ..I STAT=PRVSTAT D DELETE(PTRXTID,MLTIEN) Q
|
|---|
| 66 | ..;Different status - keep and remember status change
|
|---|
| 67 | ..D SETPRV
|
|---|
| 68 | Q
|
|---|
| 69 | ;
|
|---|
| 70 | DELETE(PTRXTID,MLTIEN) ;Delete entry from EFFECTIVE DATE/TIME multiple
|
|---|
| 71 | ; Input: PTRXTID - Pointer to XTID XTID VUID FOR SET OF CODES file
|
|---|
| 72 | ; MLTIEN - Pointer to entry in EFFECTIVE DATE/TIME multiple
|
|---|
| 73 | ;Output: None
|
|---|
| 74 | ; Notes: Assumes validity of PTRXTID & MLTIEN (internal call)
|
|---|
| 75 | S PTRXTID=+$G(PTRXTID) Q:'PTRXTID
|
|---|
| 76 | S MLTIEN=+$G(MLTIEN) Q:'MLTIEN
|
|---|
| 77 | N DA,DIK
|
|---|
| 78 | S DA=MLTIEN
|
|---|
| 79 | S DA(1)=PTRXTID
|
|---|
| 80 | S DIK="^XTID(8985.1,"_DA(1)_",""TERMSTATUS"","
|
|---|
| 81 | D ^DIK
|
|---|
| 82 | Q
|
|---|
| 83 | ;
|
|---|
| 84 | SETPRV ;Set previous values
|
|---|
| 85 | ; Input: STAT
|
|---|
| 86 | ; STDT
|
|---|
| 87 | ;Output: PRVSTAT
|
|---|
| 88 | ; PRVSTDT
|
|---|
| 89 | S PRVSTAT=$G(STAT)
|
|---|
| 90 | S PRVSTDT=$G(STDT)
|
|---|
| 91 | Q
|
|---|
