DVBADD.m

DVBADD ;ALB/MLI - DD calls from AMIE files ; 2/15/96@1

 ;;2.7;AMIE;**4**;Apr 10, 1995

 ;

 ; This routine contains calls made from AMIE DDs

 ;

EXAMSET ; set logic for .01 field of AMIE EXAM file

 ; (loops through and resets APE x-refs in file 396.4)

 ;

 ; FM passes x=new value; da=ien

 ;

 ; uses I=loop counter,RD=request date,DFN=patient

 ;

 N I,DFN,NODE,NODE2,RD

 S I=0

 I $G(X)=""!($G(DA)="") Q

 I '$D(ZTQUEUED) W !,"Setting APE x-refs with new name...please wait"

 F  S I=$O(^DVB(396.4,"F",DA,I)) Q:'I  D

 . S NODE=$G(^DVB(396.4,I,0))

 . S NODE2=$G(^DVB(396.3,+$P(NODE,"^",2),0))

 . S DFN=+NODE2,RD=+$P(NODE2,"^",2)

 . S ^DVB(396.4,"APE",DFN,X,RD,I)=""

 Q

 ;

 ;

EXAMKILL ; kill logic for .01 field of AMIE EXAM file

 ; (loops through and kills APE x-refs in file 396.4)

 ;

 ; FM passes x=new value; da=ien

 ;

 ; uses I=loop counter,RD=request date,DFN=patient

 ;

 N I,DFN,NODE,NODE2,RD

 S I=0

 I $G(X)=""!($G(DA)="") Q

 I '$D(ZTQUEUED) W !,"Killing APE x-refs with old name...please wait"

 F  S I=$O(^DVB(396.4,"F",DA,I)) Q:'I  D

 . S NODE=$G(^DVB(396.4,I,0))

 . S NODE2=$G(^DVB(396.3,+$P(NODE,"^",2),0))

 . S DFN=+NODE2,RD=+$P(NODE2,"^",2)

 . K ^DVB(396.4,"APE",DFN,X,RD,I)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DVBADD   1223     printed  Apr 09, 2024@20:58:10                                                                                                                                                                                                      Page 2

DVBADD    ;ALB/MLI - DD calls from AMIE files ; 2/15/96@1

 +1       ;;2.7;AMIE;**4**;Apr 10, 1995

 +2       ;

 +3       ; This routine contains calls made from AMIE DDs

 +4       ;

EXAMSET   ; set logic for .01 field of AMIE EXAM file

 +1       ; (loops through and resets APE x-refs in file 396.4)

 +2       ;

 +3       ; FM passes x=new value; da=ien

 +4       ;

 +5       ; uses I=loop counter,RD=request date,DFN=patient

 +6       ;

 +7        NEW I,DFN,NODE,NODE2,RD

 +8        SET I=0

 +9        IF $GET(X)=""!($GET(DA)="")

               QUIT 

 +10       IF '$DATA(ZTQUEUED)

               WRITE !,"Setting APE x-refs with new name...please wait"

 +11       FOR 

               SET I=$ORDER(^DVB(396.4,"F",DA,I))

               if 'I

                   QUIT 

               Begin DoDot:1

 +12               SET NODE=$GET(^DVB(396.4,I,0))

 +13               SET NODE2=$GET(^DVB(396.3,+$PIECE(NODE,"^",2),0))

 +14               SET DFN=+NODE2

                   SET RD=+$PIECE(NODE2,"^",2)

 +15               SET ^DVB(396.4,"APE",DFN,X,RD,I)=""

               End DoDot:1

 +16       QUIT 

 +17      ;

 +18      ;

EXAMKILL  ; kill logic for .01 field of AMIE EXAM file

 +1       ; (loops through and kills APE x-refs in file 396.4)

 +2       ;

 +3       ; FM passes x=new value; da=ien

 +4       ;

 +5       ; uses I=loop counter,RD=request date,DFN=patient

 +6       ;

 +7        NEW I,DFN,NODE,NODE2,RD

 +8        SET I=0

 +9        IF $GET(X)=""!($GET(DA)="")

               QUIT 

 +10       IF '$DATA(ZTQUEUED)

               WRITE !,"Killing APE x-refs with old name...please wait"

 +11       FOR 

               SET I=$ORDER(^DVB(396.4,"F",DA,I))

               if 'I

                   QUIT 

               Begin DoDot:1

 +12               SET NODE=$GET(^DVB(396.4,I,0))

 +13               SET NODE2=$GET(^DVB(396.3,+$PIECE(NODE,"^",2),0))

 +14               SET DFN=+NODE2

                   SET RD=+$PIECE(NODE2,"^",2)

 +15               KILL ^DVB(396.4,"APE",DFN,X,RD,I)

               End DoDot:1

 +16       QUIT