Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DG53558N

DG53558N.m

Go to the documentation of this file. 
  1. DG53558N ;ALB/GN/GTS - DG*5.3*558 CLEANUP FOR DUPE MEANS TEST FILE (cont) ; 12/14/05 15:47pm
  1.  ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
  1. CLNDUPS(DFN) ;
  1.  ;This code was removed from DG53558 and added here to allow expansion of code in DG53558.
  1.  ;Entry point to drive through TMP array and delete all Duplicates except last one per day per status
  1.  ; INPUT - DFN : Patient file IEN
  1.  ;       - Several local variables
  1.  ;
  1.  ; OUTPUT -  Several local and global variables (including TMP, and ^XTMP) (Defined and
  1.  ;           KILLed by DG53558).
  1.  ;
  1.  S ICDT=""
  1.  F  S ICDT=$O(TMP(DFN,ICDT)) Q:ICDT=""  D
  1.  . ;
  1.  . ;if this is the IVM test that is set to not prim, then flip it
  1.  . S IVMIEND=$G(TMPIVM(DFN,ICDT))  ;DG*5.3*579
  1.  . I IVMIEND D
  1.  . . D SETPRIM(IVMIEND,1,.IVMPFL)
  1.  . . S LINK=$P($G(^DGMT(408.31,IVMIEND,2)),"^",6)
  1.  . . D:LINK SETPRIM(LINK,1,.IVMPFL)  ;set any linked test to PRIM
  1.  . ;
  1.  . S MTVER=""
  1.  . F  S MTVER=$O(TMP(DFN,ICDT,MTVER)) Q:MTVER=""  D
  1.  . . ;
  1.  . . S MTST=""
  1.  . . F  S MTST=$O(TMP(DFN,ICDT,MTVER,MTST)) Q:MTST=""  D
  1.  . . .;keep at least one test per day per status, even if not PRIM
  1.  . . . D:'$D(TMP(DFN,ICDT,MTVER,MTST,"P")) SETPRI(.TMP)
  1.  . . . ;    drive thru ien's and del dupes
  1.  . . . S MTIEN=0
  1.  . . . F  S MTIEN=$O(TMP(DFN,ICDT,MTVER,MTST,MTIEN)) Q:'MTIEN  D
  1.  . . . . S PRIM=$G(^DGMT(408.31,MTIEN,"PRIM"))
  1.  . . . . S LINK=$P($G(^DGMT(408.31,MTIEN,2)),"^",6)
  1.  . . . . ;
  1.  . . . .;if this ien is primary & it is not the IVM test or Linked to
  1.  . . . .;the IVM test, then it should be flipped back to Not Primary
  1.  . . . . I IVMIEND,PRIM,MTIEN'=IVMIEND,LINK'=IVMIEND D     ;DG*5.3*579
  1.  . . . . . D SETPRIM(MTIEN,0,.IVMPFL)
  1.  . . . . . S TMP(DFN,ICDT,MTST,MTIEN)=0
  1.  . . . .;
  1.  . . . . I TMP(DFN,ICDT,MTVER,MTST,"P")'=MTIEN D
  1.  . . . . . S TYPE=$P($G(^DGMT(408.31,MTIEN,0)),"^",19),TYPNAM=""
  1.  . . . . . S:TYPE]"" TYPNAM=$G(^DG(408.33,TYPE,0))
  1.  . . . . . D DELMT^DG53558M(MTIEN,DFN,.IVMPUR,.DELETED,.LINK)
  1.  . . . . . Q:'DELETED
  1.  . . . . . S ^XTMP(NAMSPC_".DET",DFN,ICDT,MTVER,MTIEN)=TYPNAM
  1.  . . . . . I LINK,'$D(^DGMT(408.31,LINK,0)) S LINK=0
  1.  . . . . . Q:'LINK
  1.  . . . . . S LTYP=$P($G(^DGMT(408.31,LINK,0)),"^",19),LTNAM=""
  1.  . . . . . S:LTYP LTNAM=$G(^DG(408.33,LTYP,0))
  1.  . . . . . S ^XTMP(NAMSPC_".DET",DFN,ICDT,MTVER,LINK)=LTNAM
  1.  . . . . M ^XTMP(NAMSPC,DFN,ICDT,MTVER,MTST)=TMP(DFN,ICDT,MTST)
  1.  Q
  1.  ;
  1.  ;DG*5.3*579 released SETPRIM and 688 moved it to this routine.
  1. SETPRIM(DA,PR,IVMP) ; set an Income Test (in #408.31) to either Prim or Not
  1.  Q:'$D(DA)!'$D(PR)
  1.  N DR,DIE,DGDATA,DGPRI
  1.  S DGPRI=$G(^DGMT(408.31,DA,"PRIM"))
  1.  Q:DGPRI=PR                               ;quit if already at that sts
  1.  S IVMP=$G(IVMP)+1
  1.  S DGDATA="FLIPPED TO "_$S(PR=0:"NOT PRIMARY",1:"PRIMARY")
  1.  S:$D(NAMSPC) ^XTMP(NAMSPC_".DET",DFN,ICDT,DA)=DGDATA
  1.  S DR="2////"_PR,DIE="^DGMT(408.31,"
  1.  D:'$G(TESTING) ^DIE
  1.  Q
  1.  ;
  1. SETPRI(TMP) ;indicate like a primary (in TMP) to avoid it from being deleted
  1.  N IEN
  1.  S IEN=$O(TMP(DFN,ICDT,MTVER,MTST,""),-1)
  1.  S TMP(DFN,ICDT,MTVER,MTST,IEN)=1
  1.  S TMP(DFN,ICDT,MTVER,MTST,"P")=IEN
  1.  Q