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 ---[H[J[2J[HDVBADD 1223 printed Nov 22, 2024@16:51:17 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
