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

DGMTU4.m

Go to the documentation of this file.
  1. DGMTU4 ;ALB/CJM,SCG,LBD,EG,PHH,BDB MEANS TEST UTILITES ; 06/07/2005
  1. ;;5.3;Registration;**182,267,285,347,454,456,476,610,658,858**;Aug 13, 1993;Build 30
  1. ;
  1. GETSITE(DUZ) ;
  1. ;Descripition: Gets the users station number. If not found, it will
  1. ;return the station number of the primary facility.
  1. ;
  1. ;Input:
  1. ; DUZ array, pass by reference
  1. ;Output:
  1. ; Function Value - station number with suffix
  1. N FACILITY,STATION,CURSTN,CHILD,CIEN
  1. S FACILITY=""
  1. S:($G(DUZ)'=.5) FACILITY=$G(DUZ(2))
  1. I 'FACILITY S FACILITY=+$$SITE^VASITE()
  1. S:FACILITY STATION=$$STA^XUAF4(FACILITY)
  1. S CURSTN=$P($$SITE^VASITE,"^",3)
  1. I $D(STATION) D
  1. .I STATION']"" D
  1. ..D CHILDREN^XUAF4("CHILD","`"_FACILITY,"PARENT FACILITY")
  1. ..S CIEN=0 F S CIEN=$O(CHILD("C",CIEN)) Q:'CIEN I CIEN=CURSTN S STATION=$$STA^XUAF4(CIEN) Q
  1. ..I STATION']"" D
  1. ...D CHILDREN^XUAF4("CHILD","`"_FACILITY,"VISN")
  1. ...S CIEN=0 F S CIEN=$O(CHILD("C",CIEN)) Q:'CIEN I CIEN=CURSTN S STATION=$$STA^XUAF4(CIEN) Q
  1. Q $G(STATION)
  1. ;
  1. DATETIME(MTIEN) ;
  1. ;Writes date/time stamp to means test record
  1. N DATA
  1. Q:$G(IVMZ10)="UPLOAD IN PROGRESS"
  1. S DATA(2.02)=$$NOW^XLFDT
  1. I $G(MTIEN),$D(^DGMT(408.31,MTIEN,0)) I $$UPD^DGENDBS(408.31,MTIEN,.DATA)
  1. Q
  1. SAVESTAT(MTIEN,DGERR) ;
  1. ;Save the Test Determined Status (#2.03) in the ANNUAL MEANS TEST file
  1. ;(#408.31)
  1. ;
  1. ;Input:
  1. ; MTIEN - IEN of 408.31
  1. ; DGERR - (optional) 1 - Means or Copay Test is incomplete
  1. ; 0 - Means or Copay Test is complete
  1. ;
  1. ;only current statuses of P, A, or C for Means Tests and
  1. ;current status of M, or E for Copay Tests will be stored.
  1. ;
  1. ;if test is incomplete the Test Determined Status will be deleted.
  1. ;
  1. Q:('$G(MTIEN))
  1. ;
  1. N CODE,DATA,NODE0,TYPE
  1. I $G(DGERR) S DATA(2.03)="" G SET
  1. S NODE0=$G(^DGMT(408.31,MTIEN,0))
  1. S TYPE=$P(NODE0,"^",19)
  1. S CODE=$$GETCODE^DGMTH($P(NODE0,"^",3))
  1. S:CODE="A" (DATA(.11),DATA(.14))=""
  1. S DATA(2.03)=""
  1. I TYPE=1,(CODE="N") Q
  1. I TYPE=2,(CODE="L") Q
  1. I TYPE=1,(CODE'=""),"CPAG"[CODE D
  1. .S DATA(2.03)=$P(NODE0,"^",3)
  1. .I $P(NODE0,"^",20) D
  1. ..S DATA(2.03)=$$GETSTAT^DGMTH($S(CODE="P":"P",CODE="A"&(($P(NODE0,U,4)-$P(NODE0,U,15))'>$P(NODE0,U,27)):"G",1:"C"),1)
  1. I TYPE=2,(CODE'=""),"ME"[CODE S DATA(2.03)=$P(NODE0,"^",3)
  1. SET I $$UPD^DGENDBS(408.31,MTIEN,.DATA)
  1. Q
  1. MTPRIME(MTIEN) ;
  1. ;Makes the means test MTIEN primary
  1. ;
  1. N DGREQF,DGDOM1,DGADDF,DGMSGF,DGMTACT,DGMTI,DGMTINF,DGMTP,DGMTA,TRIES,DATA,NODE,DFN,MTDATE,YREND,DGMTDC,IBPRIOR,MTPRIME,LSTNODE
  1. Q:('$G(MTIEN))
  1. S MTPRIME="DGMTU4"
  1. S NODE=$G(^DGMT(408.31,MTIEN,0))
  1. Q:(NODE="")
  1. S DFN=$P($G(^DGMT(408.31,MTIEN,0)),"^",2)
  1. Q:'DFN
  1. Q:+$G(^DGMT(408.31,MTIEN,"PRIM")) ;already marked as primary!
  1. S MTDATE=+NODE
  1. Q:'MTDATE
  1. Q:($P(NODE,"^",19)'=1)
  1. ;
  1. S DGMTACT="ADD"
  1. D PRIOR^DGMTEVT
  1. ;
  1. ;marks any existing tests as non-primary - shouldn't be more than
  1. ;one such test, but give it two tries
  1. I '$$OLD(MTDATE) D
  1. .S YREND=DT_.2359
  1. E D
  1. .S YREND=$E(MTDATE,1,3)_1231.9999
  1. F TRIES=1,2 S NODE=$$LST^DGMTU(DFN,YREND,1) Q:'(+NODE) Q:($E($P(NODE,"^",2),1,3)'=$E(MTDATE,1,3)) D
  1. .N DATA
  1. .;set up for the event driver - should be treated as an edit
  1. .S:(TRIES=1) DGMTACT="EDT",DGMTI=+NODE D PRIOR^DGMTEVT
  1. .;set the old test to non-primary
  1. .S DATA(2)=0 I $$UPD^DGENDBS(408.31,+NODE,.DATA)
  1. ;
  1. ;don't want any old RX copay tests as primary either - if needed, they can be auto-created based on the means test
  1. F TRIES=1,2 S NODE=$$LST^DGMTU(DFN,YREND,2) Q:'(+NODE) Q:($E($P(NODE,"^",2),1,3)'=$E(MTDATE,1,3)) D
  1. .N DATA
  1. .;set the old test to non-primary
  1. .S DATA(2)=0 I $$UPD^DGENDBS(408.31,+NODE,.DATA)
  1. ;
  1. ;mark this test as primary
  1. K DATA S DATA(2)=1 I $$UPD^DGENDBS(408.31,MTIEN,.DATA)
  1. ;
  1. ; Get Last Primary Means Test irrespective of income year
  1. S LSTNODE=$$LST^DGMTU(DFN)
  1. ;if STATUS is REQUIRED & test is PRIMARY, then set it to NOT PRIMARY
  1. ;if the uploaded test is MT COPAY REQUIRED
  1. ; MT COPAY (CAT C) doesn't expire, which is why you have to
  1. ; flip the test to Not Primary eg 02/01/2005
  1. I $P(LSTNODE,U,4)="R",+$G(^DGMT(408.31,+LSTNODE,"PRIM")),$P(^DGMT(408.31,MTIEN,0),U,3)=6 D
  1. . N DATA S DATA(2)=0 I $$UPD^DGENDBS(408.31,+LSTNODE,.DATA)
  1. ;if means test is required and test is primary and not a CAT C,
  1. ;and it hasn't expired, flip the test to Not Primary eg 02/23/2005
  1. ;DG*5.3*858 MT less than 1 year old as of "VFA Start Date" and point forward do not expire
  1. I $P(LSTNODE,U,4)="R",+$G(^DGMT(408.31,+LSTNODE,"PRIM")),$P(^DGMT(408.31,MTIEN,0),U,3)'=6,'$$OLDMTPF(MTDATE) D
  1. . N DATA S DATA(2)=0 I $$UPD^DGENDBS(408.31,+LSTNODE,.DATA)
  1. ;
  1. ;If this is a Z10 upload, call the means test event driver and quit.
  1. ;
  1. I $G(IVMZ10)="UPLOAD IN PROGRESS" D Q
  1. .S DGMTI=MTIEN
  1. .S DGMTINF=1
  1. .D QUE^DGMTR
  1. ;
  1. ;If the test is still in effect, need to do additional checks
  1. ;and call event driver
  1. ;DG*5.3*858 MT less than 1 year old as of "VFA Start Date" and point forward do not expire
  1. I '$$OLDMTPF(MTDATE) D
  1. .;Mark this test as NO LONGER REQUIRED - calling EN^DGMTR will
  1. .;change it back to its old status if required and will que the event
  1. .;driver
  1. .K DATA
  1. .S DATA(.03)=$$GETSTAT^DGMTH("N",1)
  1. .I $$UPD^DGENDBS(408.31,MTIEN,.DATA)
  1. .S (DGADDF,DGMSGF)=1 ;don't want new test added or messages
  1. .S DGMTI=MTIEN
  1. .S DGMTINF=1
  1. .;
  1. .D EN^DGMTR
  1. .;if the test wasn't required, maybe a Rx copay test is needed
  1. .I '$G(DGREQF),'$G(DGDOM1) D COPYRX^DGMTR1(DFN,MTIEN)
  1. Q
  1. ;
  1. RXPRIME(RXIEN) ;
  1. ;Makes phramacy copay test =RXIEN the primary test
  1. ;
  1. N DGREQF,DGDOM1,DGADDF,DGMSGF,DGMTACT,DGMTI,DGMTINF,DGMTP,DGMTA,TRIES,DATA,NODE,DFN,MTIEN,DGRAUTO,DGADDF,DGMTE,DGMTCOR,DGMT,YREND,RXPRIME,QUIT
  1. ;
  1. Q:('$G(RXIEN))
  1. S RXPRIME="DGMTU4"
  1. S QUIT=0
  1. S NODE=$G(^DGMT(408.31,RXIEN,0))
  1. Q:(NODE="")
  1. S DFN=$P($G(^DGMT(408.31,RXIEN,0)),"^",2)
  1. Q:'DFN
  1. Q:+$G(^DGMT(408.31,RXIEN,"PRIM")) ;already marked as primary!
  1. S MTDATE=+NODE
  1. Q:'MTDATE
  1. Q:($P(NODE,"^",19)'=2)
  1. ;
  1. S DGMTINF=1
  1. ;
  1. ;marks any existing tests as non-primary - shouldn't be more than
  1. ;one such test, but give it two tries
  1. ;
  1. I '$$OLD(MTDATE) D
  1. .S YREND=DT_.2359
  1. E D
  1. .S YREND=$E(MTDATE,1,3)_1231.9999
  1. F TRIES=1,2 S NODE=$$LST^DGMTU(DFN,YREND,2) Q:'(+NODE) Q:($E($P(NODE,"^",2),1,3)'=$E(MTDATE,1,3)) D
  1. .N DATA
  1. .;set up for the event driver - should be treated as an edit
  1. .S:(TRIES=1) DGMTACT="EDT",DGMTI=+NODE D PRIOR^DGMTEVT
  1. .;set the old test to non-primary
  1. .S DATA(2)=0 I $$UPD^DGENDBS(408.31,+NODE,.DATA)
  1. ;
  1. ;don't want any old means tests marked as primary - unless they are actually needed! In which case, do not make this Rx test primary.
  1. F TRIES=1,2 S NODE=$$LST^DGMTU(DFN,YREND,1) Q:'(+NODE) Q:($E($P(NODE,"^",2),1,3)'=$E(MTDATE,1,3)) D
  1. .N DATA
  1. .;DG*5.3*858 MT less than 1 year old as of "VFA Start Date" and point forward do not expire
  1. .I '$$OLDMTPF($P(NODE,"^",2)),$P(NODE,"^",4)'="","ACGP"[$P(NODE,"^",4) S QUIT=1 Q
  1. .;set the old test to non-primary
  1. .S DATA(2)=0 I $$UPD^DGENDBS(408.31,+NODE,.DATA)
  1. ;
  1. I QUIT G QRXPRIME
  1. ;mark this test as primary - calling
  1. ;EN^DGMTCOR will change it to NO LONGER APPLICABLE if appropriate
  1. ;
  1. K DATA
  1. S DATA(2)=1 I $$UPD^DGENDBS(408.31,RXIEN,.DATA)
  1. ;
  1. ;If the test is still in effect, need to do additional checks
  1. ;and call event driver
  1. ;DG*5.3*858 MT less than 1 year old as of "VFA Start Date" and point forward do not expire
  1. I '$$OLDMTPF(MTDATE) D
  1. .S DGMSGF=1,DGADDF=0 ;don't want new test added or messages
  1. .;
  1. .;EN^DGMTR will first create a stub for a required MT if needed, then
  1. .;call ^DGMTCOR to set the status of the copay test
  1. .D EN^DGMTR
  1. .;
  1. .;if the pharmacy copay test was determined to be required, than
  1. .;que the event driver
  1. .I DGMTCOR D
  1. ..S DGMTACT="ADD"
  1. ..D PRIOR^DGMTEVT
  1. ..S DGMTI=RXIEN
  1. ..D QUE^DGMTR
  1. QRXPRIME ;
  1. Q
  1. ;
  1. OLD(TESTDATE) ;
  1. ;Checks if the date is older than 365 days. Returns 0 for no, 1 for yes
  1. ;if the test is exactly 365 days,
  1. ;it is considered expired eg 03/09/2005
  1. ;I ($$FMDIFF^XLFDT(DT,TESTDATE)'<365) Q 1
  1. I TESTDATE<(DT-10000) Q 1
  1. Q 0
  1. ;
  1. OLDMTPF(TESTDATE) ;
  1. ;For the Discontinue Annual Means Test Renewal project DG*5.3*858
  1. ;Checks if the date is more than 1 year older than the Discontinue
  1. ; Annual Means Test Renewal Point Forward Date.
  1. ;Discontinue Annual Means Test Renewal Point Forward Date
  1. ;Input TESTDATE - Means Test Date
  1. ;
  1. ;Output 0 for No
  1. ; 1 for Yes
  1. ;
  1. N DGMTPFD
  1. S DGMTPFD=$P(^DG(43,1,"VFA"),"^",1)
  1. I TESTDATE<(DGMTPFD-10000) Q 1
  1. Q 0
  1. ;
  1. TRANSFER(DFN,FROM,TO) ;
  1. ;transfers the Income Relations from the test=FROM to test=TO
  1. ;
  1. N DGINI,DGINR,DATA,ERROR
  1. Q:'$G(DFN)
  1. Q:'$G(FROM)
  1. Q:'$G(TO)
  1. Q:(FROM=TO)
  1. S DGINI=0 F S DGINI=$O(^DGMT(408.22,"AMT",FROM,DFN,DGINI)) Q:'DGINI S DGINR=$O(^DGMT(408.22,"AMT",FROM,DFN,DGINI,"")) I $P($G(^DGMT(408.22,+DGINR,"MT")),"^")]"" D
  1. .K DATA
  1. .S DATA(31)=TO
  1. .I $$UPD^DGENDBS(408.22,+DGINR,.DATA,.ERROR)
  1. Q
  1. ;
  1. GETINCOM(DFN,TDATE) ;
  1. ;Makes sure Income Relations point to the right test
  1. ;
  1. ;Input:
  1. ; DFN
  1. ; TDATE -income year of test (uses $E(IVMMTDT,1,3))
  1. ;Output: none. Repoints Income Relations if necessary
  1. ;
  1. N MTNODE,RXNODE,IVMMTDT,CODE,ACTVIEN
  1. Q:'$G(TDATE)
  1. Q:'$G(DFN)
  1. ;
  1. S IVMMTDT=$E(TDATE,1,3)_"1231.9"
  1. S (CODE,ACTVIEN)=""
  1. S MTNODE=$$LST^DGMTU(DFN,IVMMTDT,1) I $E($P(MTNODE,"^",2),1,3)'=$E(IVMMTDT,1,3) S MTNODE=""
  1. S RXNODE=$$LST^DGMTU(DFN,IVMMTDT,2) I $E($P(RXNODE,"^",2),1,3)'=$E(IVMMTDT,1,3) S RXNODE=""
  1. ;
  1. D
  1. .;determine which test has the associated income relations
  1. .;
  1. .I +MTNODE S CODE=$P(MTNODE,"^",4) I CODE'="",("ACGPR"[CODE) S ACTVIEN=+MTNODE Q
  1. .I +RXNODE S CODE=$P(RXNODE,"^",4) I CODE'="",("EMI"[CODE) S ACTVIEN=+RXNODE Q
  1. .I +MTNODE S ACTVIEN=+MTNODE Q
  1. .I +RXNODE S ACTVIEN=+RXNODE Q
  1. I ACTVIEN,+MTNODE,+RXNODE D TRANSFER^DGMTU4(DFN,$S((ACTVIEN=+MTNODE):+RXNODE,1:+MTNODE),ACTVIEN)
  1. Q
  1. ;
  1. CHKPT(DFN) ;
  1. ; Cross check the CURRENT MEANS TEST STATUS in the PATIENT File (#2) with the
  1. ; primary means test in the ANNUAL MEANS TEST File (#408.31). Update the
  1. ; CURRENT MEANS TEST STATUS if the fields are out of synch.
  1. ;
  1. N PATMT,DGMTI,DATA
  1. ;
  1. Q:$G(DFN)'>0
  1. Q:'$D(^DPT(DFN))
  1. S PATMT=$$GET1^DIQ(2,DFN,.14,"I")
  1. S DGMTI=+$$LST^DGMTU(DFN)
  1. S DATA(.14)=$P($G(^DGMT(408.31,DGMTI,0)),U,3)
  1. Q:DATA(.14)=PATMT
  1. ;
  1. I $$UPD^DGENDBS(2,DFN,.DATA)
  1. Q