TIUSRVPL.m

TIUSRVPL ; SLC/JER - RPC's Supporting Links ;4/20/2001 09:46

 ;;1.0;TEXT INTEGRATION UTILITIES;**63,114**;Jun 20, 1997

PUTIMAGE(TIUY,TIUDA,IMGDA) ; Create link Image-to-Document

 N D,D0,DI,DQ,DIC,DA,DIE,DR,X,Y

 I $S('+$G(IMGDA):1,'$D(^MAG(2005,+IMGDA,0)):1,1:0) D  Q

 . S TIUY="0^ Invalid Image Pointer."

 I $S('+$G(TIUDA):1,'$D(^TIU(8925,+TIUDA,0)):1,1:0) D  Q

 . S TIUY="0^ Invalid Document Pointer."

 I $$DUPLINK(TIUDA,IMGDA) S TIUY="0^ Document already linked to this image." Q

 S X=""""_"`"_TIUDA_"""",(DIC,DLAYGO)=8925.91,DIC(0)="LX"

 D ^DIC I +Y'>0 S TIUY="0^ Unable to create Image Link" Q

 S TIUY=+Y

 S DIE=DIC,DR=".02////^S X=IMGDA" D ^DIE

 Q

DUPLINK(TIUDA,IMGDA) ; identify duplicate links

 Q $S(+$O(^TIU(8925.91,"ADI",+TIUDA,+IMGDA,0)):1,1:0)

DELIMAGE(TIUY,TIUDA,IMGDA) ; Delete link Image-to-Document

 N TIUI

 I '+$O(^TIU(8925.91,"ADI",TIUDA,IMGDA,0)) D  Q

 . S TIUY="0^ Document and Image not currently linked."

 S TIUI=0

 F  S TIUI=$O(^TIU(8925.91,"ADI",TIUDA,IMGDA,TIUI)) Q:+TIUI'>0  D

 . N DIDEL,DIE,DA,DR

 . S (DIE,DIDEL)=8925.91,DR=".01///@",DA=TIUI D ^DIE

 S TIUY=1

 Q

GETILST(TIUY,TIUDA) ; Given a document, get list of associated images

 N IMGDA,TIUI S (IMGDA,TIUI)=0

 F  S IMGDA=$O(^TIU(8925.91,"ADI",TIUDA,IMGDA)) Q:+IMGDA'>0  D

 . S TIUI=TIUI+1,TIUY(TIUI)=IMGDA

 Q

GETDLST(TIUY,IMGDA) ; Given an Image, get list of associated documents

 N TIUDA,TIUI S (TIUDA,TIUI)=0

 F  S TIUDA=$O(^TIU(8925.91,"AID",IMGDA,TIUDA)) Q:+TIUDA'>0  D

 . S TIUI=TIUI+1,TIUY(TIUI)=TIUDA

 Q

TIUSRVPL  ; SLC/JER - RPC's Supporting Links ;4/20/2001 09:46

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;**63,114**;Jun 20, 1997

PUTIMAGE(TIUY,TIUDA,IMGDA) ; Create link Image-to-Document

 +1        NEW D,D0,DI,DQ,DIC,DA,DIE,DR,X,Y

 +2        IF $SELECT('+$GET(IMGDA):1,'$DATA(^MAG(2005,+IMGDA,0)):1,1:0)

               Begin DoDot:1

 +3                SET TIUY="0^ Invalid Image Pointer."

               End DoDot:1

               QUIT 

 +4        IF $SELECT('+$GET(TIUDA):1,'$DATA(^TIU(8925,+TIUDA,0)):1,1:0)

               Begin DoDot:1

 +5                SET TIUY="0^ Invalid Document Pointer."

               End DoDot:1

               QUIT 

 +6        IF $$DUPLINK(TIUDA,IMGDA)

               SET TIUY="0^ Document already linked to this image."

               QUIT 

 +7        SET X=""""_"`"_TIUDA_""""

           SET (DIC,DLAYGO)=8925.91

           SET DIC(0)="LX"

 +8        DO ^DIC

           IF +Y'>0

               SET TIUY="0^ Unable to create Image Link"

               QUIT 

 +9        SET TIUY=+Y

 +10       SET DIE=DIC

           SET DR=".02////^S X=IMGDA"

           DO ^DIE

 +11       QUIT 

DUPLINK(TIUDA,IMGDA) ; identify duplicate links

 +1        QUIT $SELECT(+$ORDER(^TIU(8925.91,"ADI",+TIUDA,+IMGDA,0)):1,1:0)

DELIMAGE(TIUY,TIUDA,IMGDA) ; Delete link Image-to-Document

 +1        NEW TIUI

 +2        IF '+$ORDER(^TIU(8925.91,"ADI",TIUDA,IMGDA,0))

               Begin DoDot:1

 +3                SET TIUY="0^ Document and Image not currently linked."

               End DoDot:1

               QUIT 

 +4        SET TIUI=0

 +5        FOR 

               SET TIUI=$ORDER(^TIU(8925.91,"ADI",TIUDA,IMGDA,TIUI))

               IF +TIUI'>0

                   QUIT 

               Begin DoDot:1

 +6                NEW DIDEL,DIE,DA,DR

 +7                SET (DIE,DIDEL)=8925.91

                   SET DR=".01///@"

                   SET DA=TIUI

                   DO ^DIE

               End DoDot:1

 +8        SET TIUY=1

 +9        QUIT 

GETILST(TIUY,TIUDA) ; Given a document, get list of associated images

 +1        NEW IMGDA,TIUI

           SET (IMGDA,TIUI)=0

 +2        FOR 

               SET IMGDA=$ORDER(^TIU(8925.91,"ADI",TIUDA,IMGDA))

               IF +IMGDA'>0

                   QUIT 

               Begin DoDot:1

 +3                SET TIUI=TIUI+1

                   SET TIUY(TIUI)=IMGDA

               End DoDot:1

 +4        QUIT 

GETDLST(TIUY,IMGDA) ; Given an Image, get list of associated documents

 +1        NEW TIUDA,TIUI

           SET (TIUDA,TIUI)=0

 +2        FOR 

               SET TIUDA=$ORDER(^TIU(8925.91,"AID",IMGDA,TIUDA))

               IF +TIUDA'>0

                   QUIT 

               Begin DoDot:1

 +3                SET TIUI=TIUI+1

                   SET TIUY(TIUI)=TIUDA

               End DoDot:1

 +4        QUIT