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

DG53285.m

Go to the documentation of this file.
  1. DG53285 ;ALB/PAK-DG*5.3*285 POST-INSTALL TO CLEAN MEANS TEST ;4/24/2000
  1. ;;5.3;Registration;**285**;Aug 13, 1993
  1. ;
  1. ; This routine is the post installation for patch DG*5.3*285
  1. ;
  1. ; The clean up is required as there is a number of redundant entries
  1. ; with a STATUS (#.03) of 'NO LONGER REQUIRED' in the Annual Means
  1. ; Test file (408.31). These were created due to the presence of a
  1. ; REQUIRED test which was primary for the current income year at the
  1. ; time the means test was uploaded.
  1. ;
  1. ; In addition, if there is a REQUIRED test present within 365 days of
  1. ; the means test under review which is primary then this is set to
  1. ; NON primary.
  1. ;
  1. ; Finally, the DG MEANS TEST DRIVER protocol is called.
  1. ;
  1. ;
  1. ; ^XTMP("DG-MTIY",MTIY) track number of records processed:
  1. ; ^XTMP("DG-MTERR") contains error messages returned from FM DBS calls:
  1. ; ^XTMP("DG-MTERR",file#,record#,field#,n)=error message
  1. ;
  1. POST ;
  1. ; post-install set up checkpoints and tracking global...
  1. N %,I,X,X1,X2
  1. I $D(XPDNM) D
  1. .; checkpoints
  1. .I $$VERCP^XPDUTL("DGMTIDT")'>0 D
  1. ..S %=$$NEWCP^XPDUTL("DGMTIDT","","-9999999")
  1. .I $$VERCP^XPDUTL("DGDFN")'>0 D
  1. ..S %=$$NEWCP^XPDUTL("DGDFN","",0)
  1. .;
  1. ;
  1. ; initialize tracking global (see text above for description)...
  1. F I="MTIY","MTERR" D
  1. .I $D(^XTMP(I)) Q
  1. .S X1=DT
  1. .S X2=30
  1. .D C^%DTC
  1. .S ^XTMP("DG-"_I,0)=X_"^"_$$DT^XLFDT_"^DG*5.3*285 POST-INSTALL "_$S(I="MTIY":"record count",1:"filing errors")
  1. ;
  1. EN ; begin processing...
  1. N %
  1. ; check status and if root checkpoint has not completed start clean up
  1. I $D(XPDNM) S %=$$VERCP^XPDUTL("DGMTIDT")
  1. I $G(%)="" S %=0
  1. I %=0 D EN1
  1. Q
  1. ;
  1. EN1 ; begin purge...
  1. ; write message to installation device and to INSTALL file (#9.7)
  1. D BMES^XPDUTL("POST INSTALLATION PROCESSING")
  1. D MES^XPDUTL("Once the post-install is completed, a mail message will")
  1. D MES^XPDUTL("be sent that will report the count of records, by income")
  1. D MES^XPDUTL("year, from which means test entries were purged.")
  1. D MES^XPDUTL("Additionally, the report will contain notes")
  1. D MES^XPDUTL("about any errors encountered during the post-installation.")
  1. D BMES^XPDUTL("Beginning purge process "_$$FMTE^XLFDT($$NOW^XLFDT))
  1. ;
  1. ; process control body
  1. N DGMTIDT,DGDFN,STA,YR,FILERR,MTIEN
  1. ;
  1. I '$D(XPDNM) S DGMTIDT=-99999999
  1. I $D(XPDNM) S DGMTIDT=$$PARCP^XPDUTL("DGMTIDT"),DGDFN=$$PARCP^XPDUTL("DGDFN")
  1. S STA=$P($$SITE^VASITE,"^",3)
  1. F S DGMTIDT=$O(^DGMT(408.31,"AS",1,3,DGMTIDT)) Q:'DGMTIDT!(DGMTIDT>-2980101) D
  1. . S:'$D(DGDFN) DGDFN=0
  1. . S YR=$E(DGMTIDT,2,4) ; get current mean test year
  1. . F S DGDFN=$O(^DGMT(408.31,"AS",1,3,DGMTIDT,DGDFN)) Q:DGDFN="" D
  1. . . N FILERR
  1. . . ;
  1. . . ; get primary means test for this year
  1. . . S NODE=$$LST^DGMTU(DGDFN,YR_"1231")
  1. . . ;
  1. . . ; - if primary means test has a STATUS of 'No Longer Required' and
  1. . . ; it has the same MEANS TEST DATE as the current test then delete
  1. . . ; all 'No Longer Required' tests for this date except the primary
  1. . . ; test.
  1. . . ; - otherwise, delete all 'No Longer Required' means test for this
  1. . . ; date except the last entry.
  1. . . I $P(NODE,U,4)="N",($P(NODE,U,2)=-DGMTIDT) S MTIEN=+NODE
  1. . . E S MTIEN=$O(^DGMT(408.31,"AS",1,3,DGMTIDT,DGDFN,""),-1)
  1. . . D DELMT(DGMTIDT,DGDFN,MTIEN,.FILERR)
  1. . . ;
  1. . . ; If 'No Longer Required' test then change 'Required'
  1. . . ; primary test for next Means Test year to Non-Primary and update
  1. . . ; STATUS of means test for current date
  1. . . D RQ2NPRM(-DGMTIDT,DGDFN,STA,YR,NODE,.FILERR)
  1. . . ;
  1. . . ; if error then update temporary store
  1. . . I $G(FILERR) M ^XTMP("DG-MTERR")=FILERR
  1. . . ; update check point with patient ID
  1. . . I $D(XPDNM) S %=$$UPCP^XPDUTL("DGDFN",DGDFN)
  1. . ; update check point with means test inverse date
  1. . I $D(XPDNM) S %=$$UPCP^XPDUTL("DGMTIDT",DGMTIDT)
  1. ;
  1. ; send mailman msg to user/HEC with results
  1. D MAIL^DG53285M
  1. I $D(XPDNM) S %=$$COMCP^XPDUTL("DGMTIDT")
  1. D MES^XPDUTL(" >>purge process completed "_$$FMTE^XLFDT($$NOW^XLFDT))
  1. Q
  1. ;
  1. DELMT(MTIDT,DFN,ENTR,ERRS) ;
  1. ; Input:
  1. ; MTIDT - Inverse Means Tets Date
  1. ; DFN - Patient identifier
  1. ; ENTR - Entry # to ignore
  1. ; ERRS - DBS file error {by reference}
  1. ;
  1. N IEN,ERR
  1. ;
  1. S IEN=0
  1. F S IEN=$O(^DGMT(408.31,"AS",1,3,MTIDT,DFN,IEN)) Q:IEN="" D
  1. . Q:IEN=ENTR
  1. . I '$$EN^IVMCMD(IEN) S ERRS(408.31,IEN,"ALL")="Unable to delete means test" Q
  1. . ; increment purged count for income year
  1. . D COUNT(MTIDT)
  1. Q
  1. ;
  1. RQ2NPRM(IDT,DFN,STA,YR,NODE,ERRS) ; change Required test to NON primary
  1. ;
  1. ; Input:
  1. ; IDT - Means Test Date
  1. ; DFN - Patient identifier
  1. ; ERRS - DBS file error {by reference}
  1. ; STA - Station number
  1. ; YR - Means Test year
  1. ; NODE - Last Primary test prior to end of Means Test year (YR)
  1. ;
  1. N NODE1,NODE2,DATA,REC31,ERR,DGADDF,DGREQF
  1. ;
  1. ; get primary test for next year
  1. S NODE1=$$LST^DGMTU(DFN,YR+1_"1231")
  1. ;
  1. ; 1. if there is no Primary test for the year in which the
  1. ; remaining 'No Longer Required' test began then make it
  1. ; primary.
  1. ; 2. if primary means test for for subsequent year is Required,
  1. ; is within 365 days of current means test date and this site
  1. ; conducted test then make primary means test NON primary.
  1. ; 3. if this site conducted test then change check if test
  1. ; is required. If it is required then the STATUS of the
  1. ; single remaining No Longer Required means test for this date
  1. ; will equal the value of the TEST-DETERMINED STATUS.
  1. ;
  1. ; (1) determine is 'No Longer Required' test should be primary
  1. S REC31=$O(^DGMT(408.31,"AS",1,3,-IDT,DFN,""))
  1. I +REC31,(+$E($P(NODE,U,2),1,3)<$E($P(^DGMT(408.31,REC31,0),U),1,3)) D
  1. . S DATA(2)=1
  1. . I '$$UPD^DGENDBS(408.31,REC31,.DATA,.ERR) S:$D(ERR) ERRS(408.31,REC31,2)=ERR
  1. .
  1. ; (2) determine if subsequent year test should be Non primary
  1. I $P(NODE1,U,2)>(YR_1231),($P(NODE1,U,4)="R"),$$SCOPE($P(NODE1,U,2),IDT) D
  1. . ; set REQUIRED test to NON primary
  1. . S DATA(2)=0
  1. . I '$$UPD^DGENDBS(408.31,+NODE1,.DATA,.ERR) S:$D(ERR) ERRS(408.31,+NODE1,2)=ERR Q
  1. ;
  1. ; (3) Check if remaining No Longer Required test for this date is
  1. ; Required
  1. Q:REC31=""
  1. S NODE2=$G(^DGMT(408.31,REC31,2))
  1. Q:$P(NODE2,U,5)'=STA
  1. D REQ(DFN,REC31,3,IDT)
  1. Q
  1. ;
  1. SCOPE(X1,X2) ; Check if dates within 365 days of one another
  1. D ^%DTC
  1. I X>365 Q 0
  1. E Q 1
  1. Q
  1. ;
  1. COUNT(DATE) ; update process tracking mechanisms...
  1. ; Input:
  1. ; DATE = inverse date from "AS" x-ref in 408.31
  1. ;
  1. N %,IY
  1. S IY=$E(DATE,2,4)-1
  1. S ^XTMP("DG-MTIY",IY)=+$G(^XTMP("DG-MTIY",IY))+1
  1. Q
  1. ;
  1. REQ(DFN,DGMTI,DGCS,IDT) ; Determine if test is Required
  1. ;
  1. ; ** amended copy of EN^DGMTR as check for latest Primary **
  1. ; ** test is not valid for this cleanup. **
  1. ;
  1. ; Input:
  1. ; DFN - Patient ID
  1. ; DGMTI - Annual Means Test IEN
  1. ; DGCS - Annual Means Test Status
  1. ; IDT - Means Test Date
  1. ;
  1. ; Output:
  1. ; DGREQF - Means Test Require Flag
  1. ; (1 if required and 0 if not required)
  1. ; DGDOM1 - DOM Patient Flag (defined and set to 1 if
  1. ; patient currently on a DOM ward)
  1. ;
  1. N DGDOM,DGMT0,DGMTYPT,OLD,DGRGAUTO,DGQSENT,DGMSGF
  1. ;
  1. S (DGMSGF,DGQSENT,DGREQF)=0,(OLD,DGMTYPT)=1
  1. I $D(^DPT(DFN,.36)) S X=^(.36) D
  1. . I $P($G(^DIC(8,+X,0)),"^",9)=5!($$SC^DGMTR(DFN)) S DGREQF=1
  1. . I $P(X,"^",2),$P(X,"^",2)<3 S DGREQF=0
  1. I DGREQF S:$G(^DPT(DFN,.38)) DGREQF=0
  1. I DGREQF D DOM^DGMTR S:$G(DGDOM) DGREQF=0
  1. S DGMT0=$G(^DGMT(408.31,DGMTI,0))
  1. I DGCS S OLD=$$OLD^DGMTU4(IDT)
  1. ;
  1. D
  1. .I DGREQF,DGCS=3,'OLD D REQ^DGMTR Q
  1. .I DGREQF,'$G(DGADDF),(('DGCS)!(OLD)) D ADD^DGMTR Q
  1. .I 'DGREQF,DGCS,DGCS'=3,'$G(DGDOM) D NOL^DGMTR Q
  1. ;
  1. ;be sure to check whether or not patient is subject to RX copay!
  1. ;
  1. D EN^DGMTCOR
  1. Q