DG53558N ;ALB/GN/GTS - DG*5.3*558 CLEANUP FOR DUPE MEANS TEST FILE (cont) ;12/14/05 15:47pm
;;5.3;Registration;**688,945**;Aug 13, 1993;Build 6
CLNDUPS(DFN) ;
;This code was removed from DG53558 and added here to allow expansion of code in DG53558.
;Entry point to drive through TMP array and delete all Duplicates except last one per day per status
; INPUT - DFN : Patient file IEN
; - Several local variables
;
; OUTPUT - Several local and global variables (including TMP, and ^XTMP) (Defined and
; KILLed by DG53558).
;
S ICDT=""
F S ICDT=$O(TMP(DFN,ICDT)) Q:ICDT="" D
. ;
. ;if this is the IVM test that is set to not prim, then flip it
. S IVMIEND=$G(TMPIVM(DFN,ICDT)) ;DG*5.3*579
. I IVMIEND D
. . D SETPRIM(IVMIEND,1,.IVMPFL)
. . S LINK=$P($G(^DGMT(408.31,IVMIEND,2)),"^",6)
. . D:LINK SETPRIM(LINK,1,.IVMPFL) ;set any linked test to PRIM
. ;
. S MTVER=""
. F S MTVER=$O(TMP(DFN,ICDT,MTVER)) Q:MTVER="" D
. . ;
. . S MTST=""
. . F S MTST=$O(TMP(DFN,ICDT,MTVER,MTST)) Q:MTST="" D
. . .;keep at least one test per day per status, even if not PRIM
. . . D:'$D(TMP(DFN,ICDT,MTVER,MTST,"P")) SETPRI(.TMP)
. . . ; drive thru ien's and del dupes
. . . S MTIEN=0
. . . F S MTIEN=$O(TMP(DFN,ICDT,MTVER,MTST,MTIEN)) Q:'MTIEN D
. . . . S PRIM=$G(^DGMT(408.31,MTIEN,"PRIM"))
. . . . S LINK=$P($G(^DGMT(408.31,MTIEN,2)),"^",6)
. . . . ;
. . . .;if this ien is primary & it is not the IVM test or Linked to
. . . .;the IVM test, then it should be flipped back to Not Primary
. . . . I IVMIEND,PRIM,MTIEN'=IVMIEND,LINK'=IVMIEND D ;DG*5.3*579
. . . . . D SETPRIM(MTIEN,0,.IVMPFL)
. . . . . S TMP(DFN,ICDT,MTVER,MTST,MTIEN)=0 ;DG*5.3*945 - insert MTVER node
. . . .;
. . . . I TMP(DFN,ICDT,MTVER,MTST,"P")'=MTIEN D
. . . . . S TYPE=$P($G(^DGMT(408.31,MTIEN,0)),"^",19),TYPNAM=""
. . . . . S:TYPE]"" TYPNAM=$G(^DG(408.33,TYPE,0))
. . . . . D DELMT^DG53558M(MTIEN,DFN,.IVMPUR,.DELETED,.LINK)
. . . . . Q:'DELETED
. . . . . S ^XTMP(NAMSPC_".DET",DFN,ICDT,MTVER,MTIEN)=TYPNAM
. . . . . I LINK,'$D(^DGMT(408.31,LINK,0)) S LINK=0
. . . . . Q:'LINK
. . . . . S LTYP=$P($G(^DGMT(408.31,LINK,0)),"^",19),LTNAM=""
. . . . . S:LTYP LTNAM=$G(^DG(408.33,LTYP,0))
. . . . . S ^XTMP(NAMSPC_".DET",DFN,ICDT,MTVER,LINK)=LTNAM
. . . . M ^XTMP(NAMSPC,DFN,ICDT,MTVER,MTST)=TMP(DFN,ICDT,MTVER,MTST) ;DG*5.3*945 insert MTVER node
Q
;
;DG*5.3*579 released SETPRIM and 688 moved it to this routine.
SETPRIM(DA,PR,IVMP) ; set an Income Test (in #408.31) to either Prim or Not
Q:'$D(DA)!'$D(PR)
N DR,DIE,DGDATA,DGPRI
S DGPRI=$G(^DGMT(408.31,DA,"PRIM"))
Q:DGPRI=PR ;quit if already at that sts
S IVMP=$G(IVMP)+1
S DGDATA="FLIPPED TO "_$S(PR=0:"NOT PRIMARY",1:"PRIMARY")
S:$D(NAMSPC) ^XTMP(NAMSPC_".DET",DFN,ICDT,DA)=DGDATA
S DR="2////"_PR,DIE="^DGMT(408.31,"
D:'$G(TESTING) ^DIE
Q
;
SETPRI(TMP) ;indicate like a primary (in TMP) to avoid it from being deleted
N IEN
S IEN=$O(TMP(DFN,ICDT,MTVER,MTST,""),-1)
S TMP(DFN,ICDT,MTVER,MTST,IEN)=1
S TMP(DFN,ICDT,MTVER,MTST,"P")=IEN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53558N 3146 printed Nov 22, 2024@17:47:49 Page 2
DG53558N ;ALB/GN/GTS - DG*5.3*558 CLEANUP FOR DUPE MEANS TEST FILE (cont) ;12/14/05 15:47pm
+1 ;;5.3;Registration;**688,945**;Aug 13, 1993;Build 6
CLNDUPS(DFN) ;
+1 ;This code was removed from DG53558 and added here to allow expansion of code in DG53558.
+2 ;Entry point to drive through TMP array and delete all Duplicates except last one per day per status
+3 ; INPUT - DFN : Patient file IEN
+4 ; - Several local variables
+5 ;
+6 ; OUTPUT - Several local and global variables (including TMP, and ^XTMP) (Defined and
+7 ; KILLed by DG53558).
+8 ;
+9 SET ICDT=""
+10 FOR
SET ICDT=$ORDER(TMP(DFN,ICDT))
if ICDT=""
QUIT
Begin DoDot:1
+11 ;
+12 ;if this is the IVM test that is set to not prim, then flip it
+13 ;DG*5.3*579
SET IVMIEND=$GET(TMPIVM(DFN,ICDT))
+14 IF IVMIEND
Begin DoDot:2
+15 DO SETPRIM(IVMIEND,1,.IVMPFL)
+16 SET LINK=$PIECE($GET(^DGMT(408.31,IVMIEND,2)),"^",6)
+17 ;set any linked test to PRIM
if LINK
DO SETPRIM(LINK,1,.IVMPFL)
End DoDot:2
+18 ;
+19 SET MTVER=""
+20 FOR
SET MTVER=$ORDER(TMP(DFN,ICDT,MTVER))
if MTVER=""
QUIT
Begin DoDot:2
+21 ;
+22 SET MTST=""
+23 FOR
SET MTST=$ORDER(TMP(DFN,ICDT,MTVER,MTST))
if MTST=""
QUIT
Begin DoDot:3
+24 ;keep at least one test per day per status, even if not PRIM
+25 if '$DATA(TMP(DFN,ICDT,MTVER,MTST,"P"))
DO SETPRI(.TMP)
+26 ; drive thru ien's and del dupes
+27 SET MTIEN=0
+28 FOR
SET MTIEN=$ORDER(TMP(DFN,ICDT,MTVER,MTST,MTIEN))
if 'MTIEN
QUIT
Begin DoDot:4
+29 SET PRIM=$GET(^DGMT(408.31,MTIEN,"PRIM"))
+30 SET LINK=$PIECE($GET(^DGMT(408.31,MTIEN,2)),"^",6)
+31 ;
+32 ;if this ien is primary & it is not the IVM test or Linked to
+33 ;the IVM test, then it should be flipped back to Not Primary
+34 ;DG*5.3*579
IF IVMIEND
IF PRIM
IF MTIEN'=IVMIEND
IF LINK'=IVMIEND
Begin DoDot:5
+35 DO SETPRIM(MTIEN,0,.IVMPFL)
+36 ;DG*5.3*945 - insert MTVER node
SET TMP(DFN,ICDT,MTVER,MTST,MTIEN)=0
End DoDot:5
+37 ;
+38 IF TMP(DFN,ICDT,MTVER,MTST,"P")'=MTIEN
Begin DoDot:5
+39 SET TYPE=$PIECE($GET(^DGMT(408.31,MTIEN,0)),"^",19)
SET TYPNAM=""
+40 if TYPE]""
SET TYPNAM=$GET(^DG(408.33,TYPE,0))
+41 DO DELMT^DG53558M(MTIEN,DFN,.IVMPUR,.DELETED,.LINK)
+42 if 'DELETED
QUIT
+43 SET ^XTMP(NAMSPC_".DET",DFN,ICDT,MTVER,MTIEN)=TYPNAM
+44 IF LINK
IF '$DATA(^DGMT(408.31,LINK,0))
SET LINK=0
+45 if 'LINK
QUIT
+46 SET LTYP=$PIECE($GET(^DGMT(408.31,LINK,0)),"^",19)
SET LTNAM=""
+47 if LTYP
SET LTNAM=$GET(^DG(408.33,LTYP,0))
+48 SET ^XTMP(NAMSPC_".DET",DFN,ICDT,MTVER,LINK)=LTNAM
End DoDot:5
+49 ;DG*5.3*945 insert MTVER node
MERGE ^XTMP(NAMSPC,DFN,ICDT,MTVER,MTST)=TMP(DFN,ICDT,MTVER,MTST)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+50 QUIT
+51 ;
+52 ;DG*5.3*579 released SETPRIM and 688 moved it to this routine.
SETPRIM(DA,PR,IVMP) ; set an Income Test (in #408.31) to either Prim or Not
+1 if '$DATA(DA)!'$DATA(PR)
QUIT
+2 NEW DR,DIE,DGDATA,DGPRI
+3 SET DGPRI=$GET(^DGMT(408.31,DA,"PRIM"))
+4 ;quit if already at that sts
if DGPRI=PR
QUIT
+5 SET IVMP=$GET(IVMP)+1
+6 SET DGDATA="FLIPPED TO "_$SELECT(PR=0:"NOT PRIMARY",1:"PRIMARY")
+7 if $DATA(NAMSPC)
SET ^XTMP(NAMSPC_".DET",DFN,ICDT,DA)=DGDATA
+8 SET DR="2////"_PR
SET DIE="^DGMT(408.31,"
+9 if '$GET(TESTING)
DO ^DIE
+10 QUIT
+11 ;
SETPRI(TMP) ;indicate like a primary (in TMP) to avoid it from being deleted
+1 NEW IEN
+2 SET IEN=$ORDER(TMP(DFN,ICDT,MTVER,MTST,""),-1)
+3 SET TMP(DFN,ICDT,MTVER,MTST,IEN)=1
+4 SET TMP(DFN,ICDT,MTVER,MTST,"P")=IEN
+5 QUIT
