DG53558N.m

DG53558N ;ALB/GN/GTS - DG*5.3*558 CLEANUP FOR DUPE MEANS TEST FILE (cont) ; 12/14/05 15:47pm

 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20

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,MTST,MTIEN)=0

 . . . .;

 . . . . 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,MTST)

 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

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

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                                                           SET TMP(DFN,ICDT,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                                       MERGE ^XTMP(NAMSPC,DFN,ICDT,MTVER,MTST)=TMP(DFN,ICDT,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