- 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 ---[H[J[2J[HDGPMDD2 1476 printed Jan 18, 2025@03:50:04 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