HDI1002A ;BPFO/JRP,ALB/RMO - PATCH 2 POST INSTALL;9/27/2005
;;1.0;HEALTH DATA & INFORMATICS;**2**;Feb 22, 2005
;
POST ;Main entry point for post-install routine
; Input: None
; All variables set by Kernel for KIDS post-installs
;Output: None
N HDIMSG
S HDIMSG(1)=" "
S HDIMSG(2)="~~~~~~~~~~~~~~~~~~~~"
S HDIMSG(3)="Post-Installation (POST^HDI1002A) will now be run"
S HDIMSG(4)=" "
D MES^XPDUTL(.HDIMSG) K HDIMSG
D SCAN
S HDIMSG(1)=" "
S HDIMSG(2)="Post-Installation ran to completion"
S HDIMSG(3)="~~~~~~~~~~~~~~~~~~~~"
S HDIMSG(4)=" "
D MES^XPDUTL(.HDIMSG) K HDIMSG
Q
;
SCAN ;Scan XTID VUID FOR SET OF CODES file for duplicate statuses
; Input: None
;Output: None
; Notes: Call assumes it is being run within the context of KIDS
N COUNT,PTRXTID,XPDIDTOT,TEXT
S TEXT(1)=" "
S TEXT(2)="Scanning EFFECTIVE DATE/TIME multiple (subfile #8985.11)"
S TEXT(3)="of the XTID VUID FOR SET OF CODES file (#8985.1) for"
S TEXT(4)="consecutive storage of the same status"
S TEXT(5)=" "
D MES^XPDUTL(.TEXT)
S XPDIDTOT=+$O(^XTID(8985.1,"A"),-1)
;Traverse file
S PTRXTID=0
F COUNT=1:1 S PTRXTID=+$O(^XTID(8985.1,PTRXTID)) Q:'PTRXTID D
.;Show progress through KIDS status bar
.I '(COUNT#10) D UPDATE^XPDID(PTRXTID)
.;Execute check
.D CHECK(PTRXTID)
D UPDATE^XPDID(XPDIDTOT)
Q
;
CHECK(PTRXTID) ;Check entry for duplicate statuses
; Input: PTRXTID - Pointer to XTID VUID FOR SET OF CODES file
;Output: None
; Notes: Assumes validity of PTRXTID (internal call)
S PTRXTID=+$G(PTRXTID) Q:'PTRXTID
N MLTIEN,STAT,STDT,PRVSTAT,PRVSTDT,NODE
S (PRVSTAT,PRVSTDT)=""
;Traverse date x-ref of multiple
S STDT=0
F S STDT=+$O(^XTID(8985.1,PTRXTID,"TERMSTATUS","B",STDT)) Q:'STDT D
.S MLTIEN=0
.F S MLTIEN=+$O(^XTID(8985.1,PTRXTID,"TERMSTATUS","B",STDT,MLTIEN)) Q:'MLTIEN D
..;Get node/status
..S NODE=$G(^XTID(8985.1,PTRXTID,"TERMSTATUS",MLTIEN,0))
..S STAT=$P(NODE,"^",2)
..;Bad node/status - delete and quit
..I (NODE="")!(NODE="^")!(STAT="") D Q
...D DELETE(PTRXTID,MLTIEN)
..;First status entry - set as previous status and quit
..I PRVSTAT="" D SETPRV Q
..;Same as previous status - delete
..I STAT=PRVSTAT D DELETE(PTRXTID,MLTIEN) Q
..;Different status - keep and remember status change
..D SETPRV
Q
;
DELETE(PTRXTID,MLTIEN) ;Delete entry from EFFECTIVE DATE/TIME multiple
; Input: PTRXTID - Pointer to XTID XTID VUID FOR SET OF CODES file
; MLTIEN - Pointer to entry in EFFECTIVE DATE/TIME multiple
;Output: None
; Notes: Assumes validity of PTRXTID & MLTIEN (internal call)
S PTRXTID=+$G(PTRXTID) Q:'PTRXTID
S MLTIEN=+$G(MLTIEN) Q:'MLTIEN
N DA,DIK
S DA=MLTIEN
S DA(1)=PTRXTID
S DIK="^XTID(8985.1,"_DA(1)_",""TERMSTATUS"","
D ^DIK
Q
;
SETPRV ;Set previous values
; Input: STAT
; STDT
;Output: PRVSTAT
; PRVSTDT
S PRVSTAT=$G(STAT)
S PRVSTDT=$G(STDT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHDI1002A 2936 printed Dec 13, 2024@01:56:13 Page 2
HDI1002A ;BPFO/JRP,ALB/RMO - PATCH 2 POST INSTALL;9/27/2005
+1 ;;1.0;HEALTH DATA & INFORMATICS;**2**;Feb 22, 2005
+2 ;
POST ;Main entry point for post-install routine
+1 ; Input: None
+2 ; All variables set by Kernel for KIDS post-installs
+3 ;Output: None
+4 NEW HDIMSG
+5 SET HDIMSG(1)=" "
+6 SET HDIMSG(2)="~~~~~~~~~~~~~~~~~~~~"
+7 SET HDIMSG(3)="Post-Installation (POST^HDI1002A) will now be run"
+8 SET HDIMSG(4)=" "
+9 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
+10 DO SCAN
+11 SET HDIMSG(1)=" "
+12 SET HDIMSG(2)="Post-Installation ran to completion"
+13 SET HDIMSG(3)="~~~~~~~~~~~~~~~~~~~~"
+14 SET HDIMSG(4)=" "
+15 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
+16 QUIT
+17 ;
SCAN ;Scan XTID VUID FOR SET OF CODES file for duplicate statuses
+1 ; Input: None
+2 ;Output: None
+3 ; Notes: Call assumes it is being run within the context of KIDS
+4 NEW COUNT,PTRXTID,XPDIDTOT,TEXT
+5 SET TEXT(1)=" "
+6 SET TEXT(2)="Scanning EFFECTIVE DATE/TIME multiple (subfile #8985.11)"
+7 SET TEXT(3)="of the XTID VUID FOR SET OF CODES file (#8985.1) for"
+8 SET TEXT(4)="consecutive storage of the same status"
+9 SET TEXT(5)=" "
+10 DO MES^XPDUTL(.TEXT)
+11 SET XPDIDTOT=+$ORDER(^XTID(8985.1,"A"),-1)
+12 ;Traverse file
+13 SET PTRXTID=0
+14 FOR COUNT=1:1
SET PTRXTID=+$ORDER(^XTID(8985.1,PTRXTID))
if 'PTRXTID
QUIT
Begin DoDot:1
+15 ;Show progress through KIDS status bar
+16 IF '(COUNT#10)
DO UPDATE^XPDID(PTRXTID)
+17 ;Execute check
+18 DO CHECK(PTRXTID)
End DoDot:1
+19 DO UPDATE^XPDID(XPDIDTOT)
+20 QUIT
+21 ;
CHECK(PTRXTID) ;Check entry for duplicate statuses
+1 ; Input: PTRXTID - Pointer to XTID VUID FOR SET OF CODES file
+2 ;Output: None
+3 ; Notes: Assumes validity of PTRXTID (internal call)
+4 SET PTRXTID=+$GET(PTRXTID)
if 'PTRXTID
QUIT
+5 NEW MLTIEN,STAT,STDT,PRVSTAT,PRVSTDT,NODE
+6 SET (PRVSTAT,PRVSTDT)=""
+7 ;Traverse date x-ref of multiple
+8 SET STDT=0
+9 FOR
SET STDT=+$ORDER(^XTID(8985.1,PTRXTID,"TERMSTATUS","B",STDT))
if 'STDT
QUIT
Begin DoDot:1
+10 SET MLTIEN=0
+11 FOR
SET MLTIEN=+$ORDER(^XTID(8985.1,PTRXTID,"TERMSTATUS","B",STDT,MLTIEN))
if 'MLTIEN
QUIT
Begin DoDot:2
+12 ;Get node/status
+13 SET NODE=$GET(^XTID(8985.1,PTRXTID,"TERMSTATUS",MLTIEN,0))
+14 SET STAT=$PIECE(NODE,"^",2)
+15 ;Bad node/status - delete and quit
+16 IF (NODE="")!(NODE="^")!(STAT="")
Begin DoDot:3
+17 DO DELETE(PTRXTID,MLTIEN)
End DoDot:3
QUIT
+18 ;First status entry - set as previous status and quit
+19 IF PRVSTAT=""
DO SETPRV
QUIT
+20 ;Same as previous status - delete
+21 IF STAT=PRVSTAT
DO DELETE(PTRXTID,MLTIEN)
QUIT
+22 ;Different status - keep and remember status change
+23 DO SETPRV
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
DELETE(PTRXTID,MLTIEN) ;Delete entry from EFFECTIVE DATE/TIME multiple
+1 ; Input: PTRXTID - Pointer to XTID XTID VUID FOR SET OF CODES file
+2 ; MLTIEN - Pointer to entry in EFFECTIVE DATE/TIME multiple
+3 ;Output: None
+4 ; Notes: Assumes validity of PTRXTID & MLTIEN (internal call)
+5 SET PTRXTID=+$GET(PTRXTID)
if 'PTRXTID
QUIT
+6 SET MLTIEN=+$GET(MLTIEN)
if 'MLTIEN
QUIT
+7 NEW DA,DIK
+8 SET DA=MLTIEN
+9 SET DA(1)=PTRXTID
+10 SET DIK="^XTID(8985.1,"_DA(1)_",""TERMSTATUS"","
+11 DO ^DIK
+12 QUIT
+13 ;
SETPRV ;Set previous values
+1 ; Input: STAT
+2 ; STDT
+3 ;Output: PRVSTAT
+4 ; PRVSTDT
+5 SET PRVSTAT=$GET(STAT)
+6 SET PRVSTDT=$GET(STDT)
+7 QUIT
