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

DGMTDD.m

Go to the documentation of this file.
  1. DGMTDD ;ALB/RMO,CAW,CJM,LBD,PHH - Annual Means Test file (#408.31) Data Dictionary Calls ; 2/10/2005 9:12am
  1. ;;5.3;Registration;**33,182,411,456,618,671**;Aug 13, 1993;Build 27
  1. ;
  1. CUR ;Cross-reference on the Status field (#.03)
  1. ;to update the Current Means Test Status field (#.14)
  1. ;in the Patient file (#2)
  1. N DFN,DGCS,DGDT,DGIX,DGMTI,DGMTS,DGNAM
  1. S DFN=$P($G(^DGMT(408.31,DA,0)),U,2),DGCS=$P($G(^DPT(DFN,0)),U,14),(DGDT,DGMTS)=""
  1. ;
  1. S DGNAM=$P($G(^DPT(DFN,0)),"^",1)
  1. Q:DGNAM=""
  1. Q:'$D(^DPT("B",DGNAM))
  1. ;
  1. S DGMTI=+$$MTIENLT^DGMTU3(1,DFN,"")
  1. I $D(^DGMT(408.31,DGMTI,0)) S DGMTS=$P(^(0),U,3) G CURQ:DGCS=DGMTS
  1. I DGCS]"" D
  1. .N DA,X
  1. .S DA=DFN,X=DGCS,DGIX=0
  1. .F S DGIX=$O(^DD(2,.14,1,DGIX)) Q:'DGIX X ^(DGIX,2) S X=DGCS
  1. D
  1. . N DR,DIE,DA,D0,DI,DIC,DQ,D,DE,DC,DH,FDA,DIERR
  1. . S FDA(2,DFN_",",.14)=DGMTS
  1. . D FILE^DIE("K","FDA","DIERR")
  1. I DGMTS]"" D
  1. .N DA,X
  1. .S DA=DFN,X=DGMTS,DGIX=0
  1. .F S DGIX=$O(^DD(2,.14,1,DGIX)) Q:'DGIX X ^(DGIX,1) S X=DGMTS
  1. CURQ Q
  1. ;
  1. COM ;Input Transform check of the Completion date/time field (#.07)
  1. N DGDT,DGMT0,XMB,XMDUZ
  1. S DGMT0=$G(^DGMT(408.31,DA,0))
  1. I X<+DGMT0 W !?5,"The completion date/time cannot be before the date of test." K X
  1. I $D(X) S DGDT=+$O(^DGMT(408.31,"AD",$P(DGMT0,U,19),$P(DGMT0,U,2),+DGMT0)) I DGDT,X'<DGDT W !?5,"The completion date/time cannot be after the next date of test." K X
  1. ; DG*5.3*411 - MT Completion Bulletin
  1. ;
  1. I $D(X) D
  1. . N EASDT S EASDT=X
  1. . Q:'$$GET1^DIQ(713,1,7,"I")
  1. . Q:$P(DGMT0,U,19)'=1
  1. . S XMB="EAS MTCOMPLETION"
  1. . S XMB(1)=$$GET1^DIQ(2,$P(DGMT0,U,2),.01)
  1. . S XMB(2)=$E($$GET1^DIQ(2,$P(DGMT0,U,2),.09),6,10)
  1. . S XMB(3)=$$FMTE^XLFDT(EASDT)
  1. . S XMB(4)=$$GET1^DIQ(200,DUZ,.01)
  1. . S XMDUZ="EAS MT Completion"
  1. . D ^XMB
  1. COMQ Q
  1. ;
  1. SCR(DGMTS,DGMTI,DGMTYPT,DGMTACT) ;Screen for the Status field (#.03)
  1. ; Input -- DGMTS Means Test Status IEN
  1. ; DGMTI Annual Means Test IEN
  1. ; DGMTYPT Type of Test 1=MT 2=COPAY
  1. ; DGMTACT Means Test Action (Opt)
  1. ; Output -- 1=SELECTABLE and 0=NOT SELECTABLE
  1. N DA,DGMT0,DGMTDT,Y
  1. S DGMT0=$G(^DGMT(408.31,DGMTI,0)),DGMTDT=+DGMT0
  1. I DGMTYPT=1,$$ACT(DGMTS,DGMTDT),$$MTS(DGMTS,DGMTDT,DGMT0,$G(DGMTACT),DGMTYPT) S Y=1
  1. I DGMTYPT=2,$$ACT(DGMTS,DGMTDT),$P(^DG(408.32,DGMTS,0),U,19)=2,$$MTS(DGMTS,DGMTDT,DGMT0,$G(DGMTACT),DGMTYPT) S Y=1
  1. Q +$G(Y)
  1. ;
  1. ACT(DGMTS,DGMTDT) ;Determine if means test status is active
  1. ; Input -- DGMTS Means Test Status IEN
  1. ; DGMTDT Date of Test
  1. ; Output -- 1=ACTIVE and 0=INACTIVE
  1. N Y
  1. S:'$P(DGMTDT,".",2) DGMTDT=DGMTDT_.2359
  1. I $D(^DG(408.32,DGMTS,"E",+$O(^(+$O(^DG(408.32,DGMTS,"E","AID",-DGMTDT)),0)),0)),$P($G(^(0)),U,2) S Y=1
  1. Q +$G(Y)
  1. ;
  1. MTS(DGMTS,DGMTDT,DGMT0,DGMTACT,DGMTYPT) ;Determine if means test status is selectable
  1. ; Input -- DGMTS Means Test Status IEN
  1. ; DGMTDT Date of Test
  1. ; DGMT0 Annual Means Test 0th node
  1. ; DGMTACT Means Test Action (Opt)
  1. ; DGMTYPT Type of Test 1=MT 2=COPAY
  1. ; Output -- 1=SELECTABLE and 0=NOT SELECTABLE
  1. N DGDET,DGINT,DGLY,DGMTPAR,DGNWT,DGOMTS,DGTHA,DGTHB,DGTHPF,DGTSRC
  1. N DGMTNWC,DGNW,DGTHG
  1. S Y=0
  1. I DGMTYPT=1 D
  1. .S DGOMTS=$P(DGMT0,U,3),DGINT=$P(DGMT0,U,4),DGNWT=$P(DGMT0,U,5),DGDET=$P(DGMT0,U,15),DGLY=$E(DGMTDT,1,3)-1_"0000"
  1. .S:$$ACT(4,DGMTDT) DGTHA=$P(DGMT0,U,12) S:$$ACT(5,DGMTDT) DGTHB=$P(DGMT0,U,13) S:$$ACT(16,DGMTDT) DGTHG=$P(DGMT0,U,27)
  1. .S DGMTPAR=$G(^DG(43,1,"MT",$S($P(DGMT0,U,16):DGLY,1:DGLY+10000),0))
  1. .S DGMTNWC=+$G(^DG(43,1,"GMT"))
  1. .S DGNW=DGNWT-DGDET+$S(DGMTNWC:0,1:DGINT)
  1. .S DGTHPF=$S(DGNW'<$P(DGMTPAR,U,8):1,1:0)
  1. .S DGTSRC=$P($G(^DG(408.34,+$P(DGMT0,U,23),0)),U)
  1. .I DGMTS=2,$G(DGMTACT)="CAT" D
  1. ..S:DGTHPF Y=1
  1. ..S:((DGTSRC="VAMC")&(DGOMTS=4)) Y=0
  1. .I DGMTS=4 S Y=1
  1. .I DGMTS=5 D
  1. ..S:DGTHPF!(DGINT>$G(DGTHA)) Y=1
  1. ..S:((DGTSRC="VAMC")&(DGOMTS=4)) Y=0
  1. .I DGMTS=6 D
  1. ..S:DGTHPF!(DGINT>$G(DGTHA)&(DGINT>$G(DGTHG))) Y=1
  1. ..S:(DGOMTS=2)&($G(DGTHG)>$G(DGTHA)) Y=0
  1. ..S:((DGTSRC="VAMC")&(DGOMTS=4)) Y=0
  1. .I DGMTS=16 D
  1. ..S:$G(DGTHG)>$G(DGTHA)&(DGTHPF!(DGINT>$G(DGTHA))) Y=1
  1. ..S:((DGTSRC="VAMC")&(DGOMTS=4)) Y=0
  1. I DGMTYPT=2 D
  1. .I DGMTS=7 S Y=1
  1. .I DGMTS=8 S Y=1
  1. .I DGMTS=9 S Y=1
  1. .I DGMTS=10 S Y=0
  1. .I DGMTS=11 S Y=0
  1. Q +$G(Y)
  1. ;
  1. STOPAUTO(DA) ;
  1. ;This is the kill logic for an xref on the Test Determined Status field.
  1. ;If the status changes, and there is a linked test via the Linked
  1. ;Rx Copay/Means Test field, the Test Determined Status of the linked
  1. ;test should be deleted.
  1. ;
  1. ;Input - DA is the ien of a test in the Annual Means Test file
  1. ;Output - none
  1. ;
  1. N LINKEDMT
  1. Q:'$G(DA)
  1. S LINKEDMT=$P($G(^DGMT(408.31,DA,2)),"^",6)
  1. I LINKEDMT D
  1. .S $P(^DGMT(408.31,LINKEDMT,2),"^",2)=$$NOW^XLFDT
  1. .S $P(^DGMT(408.31,LINKEDMT,2),"^",3)=""
  1. Q