DGPMDD2.m

DGPMDD2 ;ALB/MRL - FILE 405 'KILL' X-REFERENCES; 08 NOV 88 ; 11/5/03 1:25pm

 ;;5.3;Registration;**156,555**;Aug 13, 1993

 D FLDS I DGPMDDER G Q

 I "^1^2^3^22^"[("^"_+DGPMDDF_"^"),DGPMDD(3) K ^DGPM("ATT"_+DGPMDD(2),+DGPMDD(1),DA),^DGPM("APTT"_+DGPMDD(2),+DGPMDD(3),+DGPMDD(1),DA),^DGPM("AMV"_+DGPMDD(2),+DGPMDD(1),+DGPMDD(3),DA),^DGPM("ATID"_+DGPMDD(2),+DGPMDD(3),DGPMDDID,DA)

 I DGPMDD(2)=4!(DGPMDD(2)=5) G Q

 I "^1^3^22^"[("^"_+DGPMDDF_"^"),DGPMDD(3),DGPMDD(2)'=6 K ^DGPM("APID",+DGPMDD(3),DGPMDDID,DA),^DGPM("APRD",+DGPMDD(3),+DGPMDD(1),DA)

 I "^1^3^9^22^"[("^"_+DGPMDDF_"^"),DGPMDD(9),DGPMDD(14),DGPMDD(3) K ^DGPM("ATS",+DGPMDD(3),+DGPMDD(14),DGPMDDID,+DGPMDD(9),DA)

 I "^1^3^14^22^"[("^"_+DGPMDDF_"^"),DGPMDD(14),DGPMDD(2)'=6 K ^DGPM("APMV",+DGPMDD(3),+DGPMDD(14),DGPMDDID,DA),^DGPM("APCA",+DGPMDD(3),+DGPMDD(14),+DGPMDD(1),DA)

 I "1^3^22^23^"[("^"_+DGPMDDF_"^"),DGPMDD(23) K ^DGPM("ADMMS",DGPMDD(3),DGPMDDID,DGPMDD(23),DA)

Q K DGPMDD,DGPMDDF,DGPMDDN,DGPMDDER,DGPMDDID Q

 ;

FLDS ;Determine DGPMDD Variables based on DGPMDDF

 S DGPMDDER=0 I '$D(DGPMDDF) K X S DGPMDDER=1 Q

 K DGPMDD S DGPMDDN=^DGPM(DA,0) ;Zeroth Node

 F DGPMDD=1:1:14,22,23 S DGPMDD(DGPMDD)=$P(DGPMDDN,"^",DGPMDD)

 S DGPMDD(DGPMDDF)=X

 I $S(DGPMDD(22)=1:1,DGPMDD(22)=2:1,1:0) S DGPMDD(1)=DGPMDD(1)+(DGPMDD(22)/10000000) ;Append sequence number on dates for use in $O

 S DGPMDDID=9999999.9999999-DGPMDD(1) F DGPMDD=1,2,3,14 I DGPMDD(DGPMDD)="" Q:(DGPMDD<(DGPMDDF*100))  S DGPMDDER=1 Q

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGPMDD2   1476     printed  Apr 09, 2024@21:42:10                                                                                                                                                                                                     Page 2

DGPMDD2   ;ALB/MRL - FILE 405 'KILL' X-REFERENCES; 08 NOV 88 ; 11/5/03 1:25pm

 +1       ;;5.3;Registration;**156,555**;Aug 13, 1993

 +2        DO FLDS

           IF DGPMDDER

               GOTO Q

 +3        IF "^1^2^3^22^"[("^"_+DGPMDDF_"^")

               IF DGPMDD(3)

                   KILL ^DGPM("ATT"_+DGPMDD(2),+DGPMDD(1),DA),^DGPM("APTT"_+DGPMDD(2),+DGPMDD(3),+DGPMDD(1),DA),^DGPM("AMV"_+DGPMDD(2),+DGPMDD(1),+DGPMDD(3),DA),^DGPM("ATID"_+DGPMDD(2),+DGPMDD(3),DGPMDDID,DA)

 +4        IF DGPMDD(2)=4!(DGPMDD(2)=5)

               GOTO Q

 +5        IF "^1^3^22^"[("^"_+DGPMDDF_"^")

               IF DGPMDD(3)

                   IF DGPMDD(2)'=6

                       KILL ^DGPM("APID",+DGPMDD(3),DGPMDDID,DA),^DGPM("APRD",+DGPMDD(3),+DGPMDD(1),DA)

 +6        IF "^1^3^9^22^"[("^"_+DGPMDDF_"^")

               IF DGPMDD(9)

                   IF DGPMDD(14)

                       IF DGPMDD(3)

                           KILL ^DGPM("ATS",+DGPMDD(3),+DGPMDD(14),DGPMDDID,+DGPMDD(9),DA)

 +7        IF "^1^3^14^22^"[("^"_+DGPMDDF_"^")

               IF DGPMDD(14)

                   IF DGPMDD(2)'=6

                       KILL ^DGPM("APMV",+DGPMDD(3),+DGPMDD(14),DGPMDDID,DA),^DGPM("APCA",+DGPMDD(3),+DGPMDD(14),+DGPMDD(1),DA)

 +8        IF "1^3^22^23^"[("^"_+DGPMDDF_"^")

               IF DGPMDD(23)

                   KILL ^DGPM("ADMMS",DGPMDD(3),DGPMDDID,DGPMDD(23),DA)

Q          KILL DGPMDD,DGPMDDF,DGPMDDN,DGPMDDER,DGPMDDID

           QUIT 

 +1       ;

FLDS      ;Determine DGPMDD Variables based on DGPMDDF

 +1        SET DGPMDDER=0

           IF '$DATA(DGPMDDF)

               KILL X

               SET DGPMDDER=1

               QUIT 

 +2       ;Zeroth Node

           KILL DGPMDD

           SET DGPMDDN=^DGPM(DA,0)

 +3        FOR DGPMDD=1:1:14,22,23

               SET DGPMDD(DGPMDD)=$PIECE(DGPMDDN,"^",DGPMDD)

 +4        SET DGPMDD(DGPMDDF)=X

 +5       ;Append sequence number on dates for use in $O

           IF $SELECT(DGPMDD(22)=1:1,DGPMDD(22)=2:1,1:0)

               SET DGPMDD(1)=DGPMDD(1)+(DGPMDD(22)/10000000)

 +6        SET DGPMDDID=9999999.9999999-DGPMDD(1)

           FOR DGPMDD=1,2,3,14

               IF DGPMDD(DGPMDD)=""

                   if (DGPMDD<(DGPMDDF*100))

                       QUIT 

                   SET DGPMDDER=1

                   QUIT 

 +7        QUIT