DGMTDD ;ALB/RMO,CAW,CJM,LBD,PHH - Annual Means Test file (#408.31) Data Dictionary Calls ; 2/10/2005 9:12am
;;5.3;Registration;**33,182,411,456,618,671**;Aug 13, 1993;Build 27
;
CUR ;Cross-reference on the Status field (#.03)
;to update the Current Means Test Status field (#.14)
;in the Patient file (#2)
N DFN,DGCS,DGDT,DGIX,DGMTI,DGMTS,DGNAM
S DFN=$P($G(^DGMT(408.31,DA,0)),U,2),DGCS=$P($G(^DPT(DFN,0)),U,14),(DGDT,DGMTS)=""
;
S DGNAM=$P($G(^DPT(DFN,0)),"^",1)
Q:DGNAM=""
Q:'$D(^DPT("B",DGNAM))
;
S DGMTI=+$$MTIENLT^DGMTU3(1,DFN,"")
I $D(^DGMT(408.31,DGMTI,0)) S DGMTS=$P(^(0),U,3) G CURQ:DGCS=DGMTS
I DGCS]"" D
.N DA,X
.S DA=DFN,X=DGCS,DGIX=0
.F S DGIX=$O(^DD(2,.14,1,DGIX)) Q:'DGIX X ^(DGIX,2) S X=DGCS
D
. N DR,DIE,DA,D0,DI,DIC,DQ,D,DE,DC,DH,FDA,DIERR
. S FDA(2,DFN_",",.14)=DGMTS
. D FILE^DIE("K","FDA","DIERR")
I DGMTS]"" D
.N DA,X
.S DA=DFN,X=DGMTS,DGIX=0
.F S DGIX=$O(^DD(2,.14,1,DGIX)) Q:'DGIX X ^(DGIX,1) S X=DGMTS
CURQ Q
;
COM ;Input Transform check of the Completion date/time field (#.07)
N DGDT,DGMT0,XMB,XMDUZ
S DGMT0=$G(^DGMT(408.31,DA,0))
I X<+DGMT0 W !?5,"The completion date/time cannot be before the date of test." K X
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
; DG*5.3*411 - MT Completion Bulletin
;
I $D(X) D
. N EASDT S EASDT=X
. Q:'$$GET1^DIQ(713,1,7,"I")
. Q:$P(DGMT0,U,19)'=1
. S XMB="EAS MTCOMPLETION"
. S XMB(1)=$$GET1^DIQ(2,$P(DGMT0,U,2),.01)
. S XMB(2)=$E($$GET1^DIQ(2,$P(DGMT0,U,2),.09),6,10)
. S XMB(3)=$$FMTE^XLFDT(EASDT)
. S XMB(4)=$$GET1^DIQ(200,DUZ,.01)
. S XMDUZ="EAS MT Completion"
. D ^XMB
COMQ Q
;
SCR(DGMTS,DGMTI,DGMTYPT,DGMTACT) ;Screen for the Status field (#.03)
; Input -- DGMTS Means Test Status IEN
; DGMTI Annual Means Test IEN
; DGMTYPT Type of Test 1=MT 2=COPAY
; DGMTACT Means Test Action (Opt)
; Output -- 1=SELECTABLE and 0=NOT SELECTABLE
N DA,DGMT0,DGMTDT,Y
S DGMT0=$G(^DGMT(408.31,DGMTI,0)),DGMTDT=+DGMT0
I DGMTYPT=1,$$ACT(DGMTS,DGMTDT),$$MTS(DGMTS,DGMTDT,DGMT0,$G(DGMTACT),DGMTYPT) S Y=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
Q +$G(Y)
;
ACT(DGMTS,DGMTDT) ;Determine if means test status is active
; Input -- DGMTS Means Test Status IEN
; DGMTDT Date of Test
; Output -- 1=ACTIVE and 0=INACTIVE
N Y
S:'$P(DGMTDT,".",2) DGMTDT=DGMTDT_.2359
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
Q +$G(Y)
;
MTS(DGMTS,DGMTDT,DGMT0,DGMTACT,DGMTYPT) ;Determine if means test status is selectable
; Input -- DGMTS Means Test Status IEN
; DGMTDT Date of Test
; DGMT0 Annual Means Test 0th node
; DGMTACT Means Test Action (Opt)
; DGMTYPT Type of Test 1=MT 2=COPAY
; Output -- 1=SELECTABLE and 0=NOT SELECTABLE
N DGDET,DGINT,DGLY,DGMTPAR,DGNWT,DGOMTS,DGTHA,DGTHB,DGTHPF,DGTSRC
N DGMTNWC,DGNW,DGTHG
S Y=0
I DGMTYPT=1 D
.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"
.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)
.S DGMTPAR=$G(^DG(43,1,"MT",$S($P(DGMT0,U,16):DGLY,1:DGLY+10000),0))
.S DGMTNWC=+$G(^DG(43,1,"GMT"))
.S DGNW=DGNWT-DGDET+$S(DGMTNWC:0,1:DGINT)
.S DGTHPF=$S(DGNW'<$P(DGMTPAR,U,8):1,1:0)
.S DGTSRC=$P($G(^DG(408.34,+$P(DGMT0,U,23),0)),U)
.I DGMTS=2,$G(DGMTACT)="CAT" D
..S:DGTHPF Y=1
..S:((DGTSRC="VAMC")&(DGOMTS=4)) Y=0
.I DGMTS=4 S Y=1
.I DGMTS=5 D
..S:DGTHPF!(DGINT>$G(DGTHA)) Y=1
..S:((DGTSRC="VAMC")&(DGOMTS=4)) Y=0
.I DGMTS=6 D
..S:DGTHPF!(DGINT>$G(DGTHA)&(DGINT>$G(DGTHG))) Y=1
..S:(DGOMTS=2)&($G(DGTHG)>$G(DGTHA)) Y=0
..S:((DGTSRC="VAMC")&(DGOMTS=4)) Y=0
.I DGMTS=16 D
..S:$G(DGTHG)>$G(DGTHA)&(DGTHPF!(DGINT>$G(DGTHA))) Y=1
..S:((DGTSRC="VAMC")&(DGOMTS=4)) Y=0
I DGMTYPT=2 D
.I DGMTS=7 S Y=1
.I DGMTS=8 S Y=1
.I DGMTS=9 S Y=1
.I DGMTS=10 S Y=0
.I DGMTS=11 S Y=0
Q +$G(Y)
;
STOPAUTO(DA) ;
;This is the kill logic for an xref on the Test Determined Status field.
;If the status changes, and there is a linked test via the Linked
;Rx Copay/Means Test field, the Test Determined Status of the linked
;test should be deleted.
;
;Input - DA is the ien of a test in the Annual Means Test file
;Output - none
;
N LINKEDMT
Q:'$G(DA)
S LINKEDMT=$P($G(^DGMT(408.31,DA,2)),"^",6)
I LINKEDMT D
.S $P(^DGMT(408.31,LINKEDMT,2),"^",2)=$$NOW^XLFDT
.S $P(^DGMT(408.31,LINKEDMT,2),"^",3)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTDD 5076 printed Apr 09, 2024@21:52:53 Page 2
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
+2 ;
CUR ;Cross-reference on the Status field (#.03)
+1 ;to update the Current Means Test Status field (#.14)
+2 ;in the Patient file (#2)
+3 NEW DFN,DGCS,DGDT,DGIX,DGMTI,DGMTS,DGNAM
+4 SET DFN=$PIECE($GET(^DGMT(408.31,DA,0)),U,2)
SET DGCS=$PIECE($GET(^DPT(DFN,0)),U,14)
SET (DGDT,DGMTS)=""
+5 ;
+6 SET DGNAM=$PIECE($GET(^DPT(DFN,0)),"^",1)
+7 if DGNAM=""
QUIT
+8 if '$DATA(^DPT("B",DGNAM))
QUIT
+9 ;
+10 SET DGMTI=+$$MTIENLT^DGMTU3(1,DFN,"")
+11 IF $DATA(^DGMT(408.31,DGMTI,0))
SET DGMTS=$PIECE(^(0),U,3)
if DGCS=DGMTS
GOTO CURQ
+12 IF DGCS]""
Begin DoDot:1
+13 NEW DA,X
+14 SET DA=DFN
SET X=DGCS
SET DGIX=0
+15 FOR
SET DGIX=$ORDER(^DD(2,.14,1,DGIX))
if 'DGIX
QUIT
XECUTE ^(DGIX,2)
SET X=DGCS
End DoDot:1
+16 Begin DoDot:1
+17 NEW DR,DIE,DA,D0,DI,DIC,DQ,D,DE,DC,DH,FDA,DIERR
+18 SET FDA(2,DFN_",",.14)=DGMTS
+19 DO FILE^DIE("K","FDA","DIERR")
End DoDot:1
+20 IF DGMTS]""
Begin DoDot:1
+21 NEW DA,X
+22 SET DA=DFN
SET X=DGMTS
SET DGIX=0
+23 FOR
SET DGIX=$ORDER(^DD(2,.14,1,DGIX))
if 'DGIX
QUIT
XECUTE ^(DGIX,1)
SET X=DGMTS
End DoDot:1
CURQ QUIT
+1 ;
COM ;Input Transform check of the Completion date/time field (#.07)
+1 NEW DGDT,DGMT0,XMB,XMDUZ
+2 SET DGMT0=$GET(^DGMT(408.31,DA,0))
+3 IF X<+DGMT0
WRITE !?5,"The completion date/time cannot be before the date of test."
KILL X
+4 IF $DATA(X)
SET DGDT=+$ORDER(^DGMT(408.31,"AD",$PIECE(DGMT0,U,19),$PIECE(DGMT0,U,2),+DGMT0))
IF DGDT
IF X'<DGDT
WRITE !?5,"The completion date/time cannot be after the next date of test."
KILL X
+5 ; DG*5.3*411 - MT Completion Bulletin
+6 ;
+7 IF $DATA(X)
Begin DoDot:1
+8 NEW EASDT
SET EASDT=X
+9 if '$$GET1^DIQ(713,1,7,"I")
QUIT
+10 if $PIECE(DGMT0,U,19)'=1
QUIT
+11 SET XMB="EAS MTCOMPLETION"
+12 SET XMB(1)=$$GET1^DIQ(2,$PIECE(DGMT0,U,2),.01)
+13 SET XMB(2)=$EXTRACT($$GET1^DIQ(2,$PIECE(DGMT0,U,2),.09),6,10)
+14 SET XMB(3)=$$FMTE^XLFDT(EASDT)
+15 SET XMB(4)=$$GET1^DIQ(200,DUZ,.01)
+16 SET XMDUZ="EAS MT Completion"
+17 DO ^XMB
End DoDot:1
COMQ QUIT
+1 ;
SCR(DGMTS,DGMTI,DGMTYPT,DGMTACT) ;Screen for the Status field (#.03)
+1 ; Input -- DGMTS Means Test Status IEN
+2 ; DGMTI Annual Means Test IEN
+3 ; DGMTYPT Type of Test 1=MT 2=COPAY
+4 ; DGMTACT Means Test Action (Opt)
+5 ; Output -- 1=SELECTABLE and 0=NOT SELECTABLE
+6 NEW DA,DGMT0,DGMTDT,Y
+7 SET DGMT0=$GET(^DGMT(408.31,DGMTI,0))
SET DGMTDT=+DGMT0
+8 IF DGMTYPT=1
IF $$ACT(DGMTS,DGMTDT)
IF $$MTS(DGMTS,DGMTDT,DGMT0,$GET(DGMTACT),DGMTYPT)
SET Y=1
+9 IF DGMTYPT=2
IF $$ACT(DGMTS,DGMTDT)
IF $PIECE(^DG(408.32,DGMTS,0),U,19)=2
IF $$MTS(DGMTS,DGMTDT,DGMT0,$GET(DGMTACT),DGMTYPT)
SET Y=1
+10 QUIT +$GET(Y)
+11 ;
ACT(DGMTS,DGMTDT) ;Determine if means test status is active
+1 ; Input -- DGMTS Means Test Status IEN
+2 ; DGMTDT Date of Test
+3 ; Output -- 1=ACTIVE and 0=INACTIVE
+4 NEW Y
+5 if '$PIECE(DGMTDT,".",2)
SET DGMTDT=DGMTDT_.2359
+6 IF $DATA(^DG(408.32,DGMTS,"E",+$ORDER(^(+$ORDER(^DG(408.32,DGMTS,"E","AID",-DGMTDT)),0)),0))
IF $PIECE($GET(^(0)),U,2)
SET Y=1
+7 QUIT +$GET(Y)
+8 ;
MTS(DGMTS,DGMTDT,DGMT0,DGMTACT,DGMTYPT) ;Determine if means test status is selectable
+1 ; Input -- DGMTS Means Test Status IEN
+2 ; DGMTDT Date of Test
+3 ; DGMT0 Annual Means Test 0th node
+4 ; DGMTACT Means Test Action (Opt)
+5 ; DGMTYPT Type of Test 1=MT 2=COPAY
+6 ; Output -- 1=SELECTABLE and 0=NOT SELECTABLE
+7 NEW DGDET,DGINT,DGLY,DGMTPAR,DGNWT,DGOMTS,DGTHA,DGTHB,DGTHPF,DGTSRC
+8 NEW DGMTNWC,DGNW,DGTHG
+9 SET Y=0
+10 IF DGMTYPT=1
Begin DoDot:1
+11 SET DGOMTS=$PIECE(DGMT0,U,3)
SET DGINT=$PIECE(DGMT0,U,4)
SET DGNWT=$PIECE(DGMT0,U,5)
SET DGDET=$PIECE(DGMT0,U,15)
SET DGLY=$EXTRACT(DGMTDT,1,3)-1_"0000"
+12 if $$ACT(4,DGMTDT)
SET DGTHA=$PIECE(DGMT0,U,12)
if $$ACT(5,DGMTDT)
SET DGTHB=$PIECE(DGMT0,U,13)
if $$ACT(16,DGMTDT)
SET DGTHG=$PIECE(DGMT0,U,27)
+13 SET DGMTPAR=$GET(^DG(43,1,"MT",$SELECT($PIECE(DGMT0,U,16):DGLY,1:DGLY+10000),0))
+14 SET DGMTNWC=+$GET(^DG(43,1,"GMT"))
+15 SET DGNW=DGNWT-DGDET+$SELECT(DGMTNWC:0,1:DGINT)
+16 SET DGTHPF=$SELECT(DGNW'<$PIECE(DGMTPAR,U,8):1,1:0)
+17 SET DGTSRC=$PIECE($GET(^DG(408.34,+$PIECE(DGMT0,U,23),0)),U)
+18 IF DGMTS=2
IF $GET(DGMTACT)="CAT"
Begin DoDot:2
+19 if DGTHPF
SET Y=1
+20 if ((DGTSRC="VAMC")&(DGOMTS=4))
SET Y=0
End DoDot:2
+21 IF DGMTS=4
SET Y=1
+22 IF DGMTS=5
Begin DoDot:2
+23 if DGTHPF!(DGINT>$GET(DGTHA))
SET Y=1
+24 if ((DGTSRC="VAMC")&(DGOMTS=4))
SET Y=0
End DoDot:2
+25 IF DGMTS=6
Begin DoDot:2
+26 if DGTHPF!(DGINT>$GET(DGTHA)&(DGINT>$GET(DGTHG)))
SET Y=1
+27 if (DGOMTS=2)&($GET(DGTHG)>$GET(DGTHA))
SET Y=0
+28 if ((DGTSRC="VAMC")&(DGOMTS=4))
SET Y=0
End DoDot:2
+29 IF DGMTS=16
Begin DoDot:2
+30 if $GET(DGTHG)>$GET(DGTHA)&(DGTHPF!(DGINT>$GET(DGTHA)))
SET Y=1
+31 if ((DGTSRC="VAMC")&(DGOMTS=4))
SET Y=0
End DoDot:2
End DoDot:1
+32 IF DGMTYPT=2
Begin DoDot:1
+33 IF DGMTS=7
SET Y=1
+34 IF DGMTS=8
SET Y=1
+35 IF DGMTS=9
SET Y=1
+36 IF DGMTS=10
SET Y=0
+37 IF DGMTS=11
SET Y=0
End DoDot:1
+38 QUIT +$GET(Y)
+39 ;
STOPAUTO(DA) ;
+1 ;This is the kill logic for an xref on the Test Determined Status field.
+2 ;If the status changes, and there is a linked test via the Linked
+3 ;Rx Copay/Means Test field, the Test Determined Status of the linked
+4 ;test should be deleted.
+5 ;
+6 ;Input - DA is the ien of a test in the Annual Means Test file
+7 ;Output - none
+8 ;
+9 NEW LINKEDMT
+10 if '$GET(DA)
QUIT
+11 SET LINKEDMT=$PIECE($GET(^DGMT(408.31,DA,2)),"^",6)
+12 IF LINKEDMT
Begin DoDot:1
+13 SET $PIECE(^DGMT(408.31,LINKEDMT,2),"^",2)=$$NOW^XLFDT
+14 SET $PIECE(^DGMT(408.31,LINKEDMT,2),"^",3)=""
End DoDot:1
+15 QUIT
