Routine: TIUCWD

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)

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUCWD   1165     printed  Apr 09, 2024@21:49:08                                                                                                                                                                                                      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

TIUCWD.m