TIUCWD ;SLC/TDP - TIU CWAD POSTING AUTO-DEMOTION ;01/13/15 12:19
;;1.0;TEXT INTEGRATION UTILITIES;**291**;Jun 20, 1997;Build 5
;
SILENT(TIUFROM,TIUTO) ;
I +$G(TIUDA)&('+$G(DFN)) D ;TO GET DFN BASED ON TIUDA IF NOT PRESENT
. S DFN=+$P($G(^TIU(8925,TIUDA,0)),"^",2)
Q:'$G(DFN)
N TIUNDT,TIUNIEN,TIUCLIK
Q:$G(^TIU(8925.1,+TIUFROM,0))']""
Q:$G(^TIU(8925.1,+TIUTO,0))']""
S (TIUNDT,TIUCLIK)=0 F S TIUNDT=$O(^TIU(8925,"APT",DFN,TIUFROM,7,TIUNDT)) Q:'+TIUNDT D
. S TIUNIEN=0 F S TIUNIEN=$O(^TIU(8925,"APT",DFN,TIUFROM,7,TIUNDT,TIUNIEN)) Q:'+TIUNIEN D
.. S TIUCLIK=TIUCLIK+1 Q:(TIUCLIK'>1) ;LEAVE THE MOST RECENT NOTE
.. D DEMOTE(TIUNIEN,TIUTO)
Q
DEMOTE(TIUDA,TIUTO) ;
N DIE,DR,CHKSUM,LOCKTM
S LOCKTM=$S(+DILOCKTM>1:DILOCKTM,1:1)
L +^TIU(8925,TIUDA,0):LOCKTM
E D Q
. W:$E(IOST,1,2)="C-" !,"Unable to obtain lock for entry "_TIUDA
S DIE=8925,DA=TIUDA
S DR=".01////^S X="_TIUTO_";.04////^S X="_$$DOCCLASS^TIULC1(TIUTO)
D ^DIE
S CHKSUM=+$$CHKSUM^TIULC("^TIU(8925,"_+TIUDA_",""TEXT"")")
D AUDIT^TIUEDI1(TIUDA,CHKSUM,CHKSUM)
L -^TIU(8925,TIUDA,0)
W:$E(IOST,1,2)="C-" !,"Entry demoted from posting status "_TIUDA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUCWD 1165 printed Nov 22, 2024@17:49:32 Page 2
TIUCWD ;SLC/TDP - TIU CWAD POSTING AUTO-DEMOTION ;01/13/15 12:19
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**291**;Jun 20, 1997;Build 5
+2 ;
SILENT(TIUFROM,TIUTO) ;
+1 ;TO GET DFN BASED ON TIUDA IF NOT PRESENT
IF +$GET(TIUDA)&('+$GET(DFN))
Begin DoDot:1
+2 SET DFN=+$PIECE($GET(^TIU(8925,TIUDA,0)),"^",2)
End DoDot:1
+3 if '$GET(DFN)
QUIT
+4 NEW TIUNDT,TIUNIEN,TIUCLIK
+5 if $GET(^TIU(8925.1,+TIUFROM,0))']""
QUIT
+6 if $GET(^TIU(8925.1,+TIUTO,0))']""
QUIT
+7 SET (TIUNDT,TIUCLIK)=0
FOR
SET TIUNDT=$ORDER(^TIU(8925,"APT",DFN,TIUFROM,7,TIUNDT))
if '+TIUNDT
QUIT
Begin DoDot:1
+8 SET TIUNIEN=0
FOR
SET TIUNIEN=$ORDER(^TIU(8925,"APT",DFN,TIUFROM,7,TIUNDT,TIUNIEN))
if '+TIUNIEN
QUIT
Begin DoDot:2
+9 ;LEAVE THE MOST RECENT NOTE
SET TIUCLIK=TIUCLIK+1
if (TIUCLIK'>1)
QUIT
+10 DO DEMOTE(TIUNIEN,TIUTO)
End DoDot:2
End DoDot:1
+11 QUIT
DEMOTE(TIUDA,TIUTO) ;
+1 NEW DIE,DR,CHKSUM,LOCKTM
+2 SET LOCKTM=$SELECT(+DILOCKTM>1:DILOCKTM,1:1)
+3 LOCK +^TIU(8925,TIUDA,0):LOCKTM
+4 IF '$TEST
Begin DoDot:1
+5 if $EXTRACT(IOST,1,2)="C-"
WRITE !,"Unable to obtain lock for entry "_TIUDA
End DoDot:1
QUIT
+6 SET DIE=8925
SET DA=TIUDA
+7 SET DR=".01////^S X="_TIUTO_";.04////^S X="_$$DOCCLASS^TIULC1(TIUTO)
+8 DO ^DIE
+9 SET CHKSUM=+$$CHKSUM^TIULC("^TIU(8925,"_+TIUDA_",""TEXT"")")
+10 DO AUDIT^TIUEDI1(TIUDA,CHKSUM,CHKSUM)
+11 LOCK -^TIU(8925,TIUDA,0)
+12 if $EXTRACT(IOST,1,2)="C-"
WRITE !,"Entry demoted from posting status "_TIUDA
+13 QUIT
