- 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 Feb 18, 2025@23:07:28 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