- 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 Feb 19, 2025@00:10:45 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