- DG53130P ;ALB/SEK INCORRECT COPAY STATUS CLEANUP POST-INS ; 06/24/97
- ;;5.3;Registration;**130**;Aug 13, 1993
- ;
- ;This routine will be run as post-installation for patch DG*5.3*130.
- ;This routine will change the STATUS field (#.03) to 8 (non-exempt)
- ;from 9 (incomplete) in the ANNUAL MEANS TEST file (#408.13) for
- ;copay tests when the veteran declines to give income information.
- ;
- POST ;entry point for post-install, setting up checkpoints
- N %
- S %=$$NEWCP^XPDUTL("DGTTDT","EN^DG53130P",-9999999)
- Q
- ;
- EN ;begin processing
- ;
- ;update PACKAGE file for installation of IVM patch IVM*2*8
- D UPDATE
- ;
- ;go through ANNUAL MEANS TEST file changing STATUS to 8 from 9
- ;for copay tests when veteran declines to give income information.
- N DGTTDT
- ;
- D BMES^XPDUTL(" >> Copay incomplete status cleanup")
- ;
- ;get value from checkpoints, previous run
- S DGTTDT=+$$PARCP^XPDUTL("DGTTDT")
- ;
- D LOOP
- D MAIL
- Q
- ;
- ;
- UPDATE ; update PACKAGE file for install of IVM patch IVM*2*8
- N PKG,VER,PATCH
- ; find ien of IVM in PACKAGE file
- S PKG=$O(^DIC(9.4,"B","INCOME VERIFICATION MATCH",0)) Q:'PKG
- S VER="2.0" ; version
- S PATCH="8^"_DT_"^"_DUZ ; patch #^today^installed by
- ;
- D BMES^XPDUTL(" >>Updating Patch Application History for IVM with IVM*2*8")
- S PATCH=$$PKGPAT^XPDIP(PKG,VER,.PATCH)
- Q
- ;
- ;
- LOOP ;
- N DFN,DGFL,DGFLD,DGIEN,DGINY,DGMTA,DGVAL,%
- S ^XTMP("DG53130P",0)=$$FMADD^XLFDT(DT+30)_"^"_DT_"^"_"COPAY STATUS CHANGED LOG" ;temp array
- F S DGTTDT=$O(^DGMT(408.31,"AS",2,9,DGTTDT)) Q:'DGTTDT D
- .S DFN=0 F S DFN=$O(^DGMT(408.31,"AS",2,9,DGTTDT,DFN)) Q:'DFN D
- ..S DGIEN=0 F S DGIEN=$O(^DGMT(408.31,"AS",2,9,DGTTDT,DFN,DGIEN)) Q:'DGIEN D
- ...S DGMTA=$G(^DGMT(408.31,DGIEN,0)) Q:'DGMTA
- ...Q:'$P(DGMTA,"^",14)
- ...S DGFL=408.31,DGFLD=.03,DGVAL=9 D KILL^DGMTR
- ...S DGVAL=8,$P(^DGMT(408.31,DGIEN,0),"^",3)=DGVAL D SET^DGMTR
- ...;
- ...;get income year
- ...S Y=$E(DGTTDT,2,4) S Y=Y-1 X ^DD("DD") S DGINY=Y
- ...;
- ...; - build list of copay tests changed
- ...D BUILDLN
- ...;
- .;update checkpoint
- .S %=$$UPCP^XPDUTL("DGTTDT",DGTTDT)
- Q
- ;
- ;
- ;
- BUILDLN ; Build storage array with data
- ;
- ; Output:
- ; ^XTMP("DG53130P",pt name,pt ssn,income year)=""
- ;
- N DGNAME,DGSSN
- ;
- ; - pt name and ssn from Patient (#2) file
- S DGNAME=$P($G(^DPT(DFN,0)),"^"),DGSSN=$P($G(^(.36)),"^",3)
- S:DGNAME="" DGNAME=DFN
- S:DGSSN="" DGSSN="MISSING"
- ;
- S ^XTMP("DG53130P",DGNAME,DGSSN,DGINY)=""
- Q
- ;
- ;
- MAIL ; Send a mailman msg to user listing copay tests with status change
- N DIFROM,%
- N DGCTR,DGCTXT,DGCX,X,XMDUZ,XMSUB,XMTEXT,XMY,Y
- D BMES^XPDUTL(" >> cleanup done.")
- D BMES^XPDUTL(" >> Sending mailman msg listing copay tests with status change.")
- S XMSUB="LIST OF COPAY TESTS WITH STATUS CHANGE"
- S XMDUZ="REGISTRATION PACKAGE",XMY(DUZ)="",XMY(.5)=""
- S XMTEXT="DGCTXT("
- S DGCX=$$SITE^VASITE
- D NOW^%DTC S Y=% D DD^%DT
- S DGCTXT(1)="LIST OF COPAY TESTS WITH STATUS CHANGE FROM INCOMPLETE TO NON-EXEMPT"
- S DGCTXT(2)=" WHEN THE PATIENT DECLINES TO GIVE INCOME INFORMATION"
- S DGCTXT(3)=" "
- I $O(^XTMP("DG53130P",0))']"" D G MAIL1
- .S DGCTXT(4)="No copay tests changed."
- .S DGCTXT(5)=" "
- S DGCTXT(4)="Patient Name Patient SSN Income Year"
- S DGCTXT(5)="============================================================"
- ;
- ; - create list of patients
- N DGBLANK,DGLINE,DGNM,DGNUM
- S DGBLANK="",$P(DGBLANK," ",30)="",DGCTR=8
- S DGNM="" F S DGNM=$O(^XTMP("DG53130P",DGNM)) Q:DGNM']"" D
- .S DGNUM="" F S DGNUM=$O(^XTMP("DG53130P",DGNM,DGNUM)) Q:DGNUM']"" D
- ..S DGLINE="" F S DGLINE=$O(^XTMP("DG53130P",DGNM,DGNUM,DGLINE)) Q:DGLINE']"" D
- ...S DGCTR=DGCTR+1
- ...S DGCTXT(DGCTR)=$E(DGNM_DGBLANK,1,30)_" "_$E(DGNUM_DGBLANK,1,15)_" "_$E(DGLINE_DGBLANK,1,10)
- ;
- MAIL1 D ^XMD
- D MES^XPDUTL(" >> message sent.")
- K ^XTMP("DG53130P")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53130P 3896 printed Jan 18, 2025@03:36:51 Page 2
- DG53130P ;ALB/SEK INCORRECT COPAY STATUS CLEANUP POST-INS ; 06/24/97
- +1 ;;5.3;Registration;**130**;Aug 13, 1993
- +2 ;
- +3 ;This routine will be run as post-installation for patch DG*5.3*130.
- +4 ;This routine will change the STATUS field (#.03) to 8 (non-exempt)
- +5 ;from 9 (incomplete) in the ANNUAL MEANS TEST file (#408.13) for
- +6 ;copay tests when the veteran declines to give income information.
- +7 ;
- POST ;entry point for post-install, setting up checkpoints
- +1 NEW %
- +2 SET %=$$NEWCP^XPDUTL("DGTTDT","EN^DG53130P",-9999999)
- +3 QUIT
- +4 ;
- EN ;begin processing
- +1 ;
- +2 ;update PACKAGE file for installation of IVM patch IVM*2*8
- +3 DO UPDATE
- +4 ;
- +5 ;go through ANNUAL MEANS TEST file changing STATUS to 8 from 9
- +6 ;for copay tests when veteran declines to give income information.
- +7 NEW DGTTDT
- +8 ;
- +9 DO BMES^XPDUTL(" >> Copay incomplete status cleanup")
- +10 ;
- +11 ;get value from checkpoints, previous run
- +12 SET DGTTDT=+$$PARCP^XPDUTL("DGTTDT")
- +13 ;
- +14 DO LOOP
- +15 DO MAIL
- +16 QUIT
- +17 ;
- +18 ;
- UPDATE ; update PACKAGE file for install of IVM patch IVM*2*8
- +1 NEW PKG,VER,PATCH
- +2 ; find ien of IVM in PACKAGE file
- +3 SET PKG=$ORDER(^DIC(9.4,"B","INCOME VERIFICATION MATCH",0))
- if 'PKG
- QUIT
- +4 ; version
- SET VER="2.0"
- +5 ; patch #^today^installed by
- SET PATCH="8^"_DT_"^"_DUZ
- +6 ;
- +7 DO BMES^XPDUTL(" >>Updating Patch Application History for IVM with IVM*2*8")
- +8 SET PATCH=$$PKGPAT^XPDIP(PKG,VER,.PATCH)
- +9 QUIT
- +10 ;
- +11 ;
- LOOP ;
- +1 NEW DFN,DGFL,DGFLD,DGIEN,DGINY,DGMTA,DGVAL,%
- +2 ;temp array
- SET ^XTMP("DG53130P",0)=$$FMADD^XLFDT(DT+30)_"^"_DT_"^"_"COPAY STATUS CHANGED LOG"
- +3 FOR
- SET DGTTDT=$ORDER(^DGMT(408.31,"AS",2,9,DGTTDT))
- if 'DGTTDT
- QUIT
- Begin DoDot:1
- +4 SET DFN=0
- FOR
- SET DFN=$ORDER(^DGMT(408.31,"AS",2,9,DGTTDT,DFN))
- if 'DFN
- QUIT
- Begin DoDot:2
- +5 SET DGIEN=0
- FOR
- SET DGIEN=$ORDER(^DGMT(408.31,"AS",2,9,DGTTDT,DFN,DGIEN))
- if 'DGIEN
- QUIT
- Begin DoDot:3
- +6 SET DGMTA=$GET(^DGMT(408.31,DGIEN,0))
- if 'DGMTA
- QUIT
- +7 if '$PIECE(DGMTA,"^",14)
- QUIT
- +8 SET DGFL=408.31
- SET DGFLD=.03
- SET DGVAL=9
- DO KILL^DGMTR
- +9 SET DGVAL=8
- SET $PIECE(^DGMT(408.31,DGIEN,0),"^",3)=DGVAL
- DO SET^DGMTR
- +10 ;
- +11 ;get income year
- +12 SET Y=$EXTRACT(DGTTDT,2,4)
- SET Y=Y-1
- XECUTE ^DD("DD")
- SET DGINY=Y
- +13 ;
- +14 ; - build list of copay tests changed
- +15 DO BUILDLN
- +16 ;
- End DoDot:3
- End DoDot:2
- +17 ;update checkpoint
- +18 SET %=$$UPCP^XPDUTL("DGTTDT",DGTTDT)
- End DoDot:1
- +19 QUIT
- +20 ;
- +21 ;
- +22 ;
- BUILDLN ; Build storage array with data
- +1 ;
- +2 ; Output:
- +3 ; ^XTMP("DG53130P",pt name,pt ssn,income year)=""
- +4 ;
- +5 NEW DGNAME,DGSSN
- +6 ;
- +7 ; - pt name and ssn from Patient (#2) file
- +8 SET DGNAME=$PIECE($GET(^DPT(DFN,0)),"^")
- SET DGSSN=$PIECE($GET(^(.36)),"^",3)
- +9 if DGNAME=""
- SET DGNAME=DFN
- +10 if DGSSN=""
- SET DGSSN="MISSING"
- +11 ;
- +12 SET ^XTMP("DG53130P",DGNAME,DGSSN,DGINY)=""
- +13 QUIT
- +14 ;
- +15 ;
- MAIL ; Send a mailman msg to user listing copay tests with status change
- +1 NEW DIFROM,%
- +2 NEW DGCTR,DGCTXT,DGCX,X,XMDUZ,XMSUB,XMTEXT,XMY,Y
- +3 DO BMES^XPDUTL(" >> cleanup done.")
- +4 DO BMES^XPDUTL(" >> Sending mailman msg listing copay tests with status change.")
- +5 SET XMSUB="LIST OF COPAY TESTS WITH STATUS CHANGE"
- +6 SET XMDUZ="REGISTRATION PACKAGE"
- SET XMY(DUZ)=""
- SET XMY(.5)=""
- +7 SET XMTEXT="DGCTXT("
- +8 SET DGCX=$$SITE^VASITE
- +9 DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- +10 SET DGCTXT(1)="LIST OF COPAY TESTS WITH STATUS CHANGE FROM INCOMPLETE TO NON-EXEMPT"
- +11 SET DGCTXT(2)=" WHEN THE PATIENT DECLINES TO GIVE INCOME INFORMATION"
- +12 SET DGCTXT(3)=" "
- +13 IF $ORDER(^XTMP("DG53130P",0))']""
- Begin DoDot:1
- +14 SET DGCTXT(4)="No copay tests changed."
- +15 SET DGCTXT(5)=" "
- End DoDot:1
- GOTO MAIL1
- +16 SET DGCTXT(4)="Patient Name Patient SSN Income Year"
- +17 SET DGCTXT(5)="============================================================"
- +18 ;
- +19 ; - create list of patients
- +20 NEW DGBLANK,DGLINE,DGNM,DGNUM
- +21 SET DGBLANK=""
- SET $PIECE(DGBLANK," ",30)=""
- SET DGCTR=8
- +22 SET DGNM=""
- FOR
- SET DGNM=$ORDER(^XTMP("DG53130P",DGNM))
- if DGNM']""
- QUIT
- Begin DoDot:1
- +23 SET DGNUM=""
- FOR
- SET DGNUM=$ORDER(^XTMP("DG53130P",DGNM,DGNUM))
- if DGNUM']""
- QUIT
- Begin DoDot:2
- +24 SET DGLINE=""
- FOR
- SET DGLINE=$ORDER(^XTMP("DG53130P",DGNM,DGNUM,DGLINE))
- if DGLINE']""
- QUIT
- Begin DoDot:3
- +25 SET DGCTR=DGCTR+1
- +26 SET DGCTXT(DGCTR)=$EXTRACT(DGNM_DGBLANK,1,30)_" "_$EXTRACT(DGNUM_DGBLANK,1,15)_" "_$EXTRACT(DGLINE_DGBLANK,1,10)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +27 ;
- MAIL1 DO ^XMD
- +1 DO MES^XPDUTL(" >> message sent.")
- +2 KILL ^XTMP("DG53130P")
- +3 QUIT