DG53661P ; ALB/TK,LBD - DG*5.3*661 POST INSTALL CONVERSION ROUTINE ; 5/18/10 1:11pm
;;5.3;Registration;**661**;Aug 13, 1993;Build 5
;
EN ; Entry point for post installation routine DG*5.3*661
N NAMSPC,ZTDESC,ZTDTH,ZTRTN,ZTSK
S NAMSPC=$$NAMSPC
S ZTRTN="CTLINKS^DG53661P("""_NAMSPC_""")"
S ZTDESC="DG*5.3*661 Cleanup Invalid MT/CT Links"
S ZTIO="",ZTDTH=$$NOW^XLFDT
D ^%ZTLOAD
D BMES^XPDUTL("Cleanup Invalid MT/CT Links Process started - task #"_$G(ZTSK))
Q
;
CTLINKS(NAMSPC) ; entry for clearing invalid Rx copay test links
N CT,CT1,DA,DFN,DIE,DR,IVM,IVMCT,IVMNOW,X,Y,Z
I '$D(^XTMP(NAMSPC)) D
. S ^XTMP(NAMSPC,0)=$$FMADD^XLFDT(DT,180)_U_DT_U_"CLEAN UP INVALID MEANS TEST/COPAY TEST LINKS",^XTMP(NAMSPC,"PARAMS")=""
S Z=$G(^XTMP(NAMSPC,"PARAMS"))
I $P(Z,U,4)="RUNNING" D Q
. S ^XTMP(NAMSPC,"RUNNING",$$NOW^XLFDT)="UPDATE ALREADY RUNNING"
. D BULL(NAMSPC,,,,"RUNNING")
I $P(Z,U,4)="DONE" D Q
. S ^XTMP(NAMSPC,"RUNNING",$$NOW^XLFDT)="UPDATE ALREADY COMPLETE"
. D BULL(NAMSPC,,,,"DONE")
S $P(^XTMP(NAMSPC,"PARAMS"),U,4)="RUNNING"
S IVMNOW=$$NOW^XLFDT,^XTMP(NAMSPC,"RUNNING",IVMNOW)="",^XTMP(NAMSPC,"RUNNING",IVMNOW,+$G(ZTSK))=""
S CT=+Z,IVM=+$P(Z,U,2),CT1=+$P(Z,U,3)
F S IVM=$O(^DGMT(408.31,IVM)) Q:'IVM D
. S IVMCT=$P($G(^DGMT(408.31,IVM,2)),U,6) Q:$$STOP(CT1) S CT1=CT1+1,$P(^XTMP(NAMSPC,"PARAMS"),U,2,3)=IVM_U_CT1
. S DFN=+$P($G(^DGMT(408.31,IVM,0)),U,2)
. I IVMCT D ; Check for copay test for same income year as means test
.. ; OK if years match
.. I $$YR(IVM)=$$YR(IVMCT) Q
.. ; Delete link to income test in a different income year
.. S DA=IVM,DIE="^DGMT(408.31,",DR="2.06///@"
.. D ^DIE
.. S CT=CT+1,$P(^XTMP(NAMSPC,"PARAMS"),U,1)=CT
.. S ^XTMP(NAMSPC,"LINK_DELETED",IVM,IVMCT)=""
S $P(^XTMP(NAMSPC,"PARAMS"),U,4)=$S('$G(ZTSTOP):"DONE",1:"STOPPED"),^XTMP(NAMSPC,"RUNNING",IVMNOW)=$$NOW^XLFDT
D BULL(NAMSPC,CT,CT1,IVMNOW,'$G(ZTSTOP))
Q
;
BULL(NAMSPC,CHANGED,READ,WHEN,DONE) ; Send bulletin
N LN,TMP,XMDUZ,XMSUB,XMTEXT,XMY
S XMY(DUZ)="",XMY("G.DGEN ELIGIBILITY ALERT")="",XMDUZ=.5,XMTEXT="TMP("""_NAMSPC_""","
; Set up copay test 'links' deleted bulletin
S XMSUB=NAMSPC_": COPAY TEST LINK CLEANUP - SUMMARY REPORT"
S LN=1
S TMP(NAMSPC,LN)=""
S LN=LN+1
S TMP(NAMSPC,LN)="COPAY TEST INVALID LINK UPDATE RESULTS"
S LN=LN+1
S TMP(NAMSPC,LN)="--------------------------------------"
S LN=LN+1
S TMP(NAMSPC,LN)=""
I DONE="RUNNING" D Q
. S LN=LN+1
. S TMP(NAMSPC,LN)="Sorry, a copay test link clean up is already running."
. S LN=LN+1
. S TMP(NAMSPC,LN)=""
. D ^XMD
I DONE="DONE" D Q
. S LN=LN+1
. S TMP(NAMSPC,LN)="Sorry, the copay test link clean up has already completed."
. S LN=LN+1
. S TMP(NAMSPC,LN)=""
. D ^XMD
S LN=LN+1
S TMP(NAMSPC,LN)="The cleanup has "_$S(DONE:"run to completion",1:"finished a partial run")_". Here are the results"_$S(DONE:"",1:" to date")_":"
S LN=LN+1
S TMP(NAMSPC,LN)=""
S LN=LN+1
S TMP(NAMSPC,LN)=" Start Date/Time: "_$$FMTE^XLFDT(WHEN)
S LN=LN+1
S TMP(NAMSPC,LN)=" End Date/Time: "_$$FMTE^XLFDT($G(^XTMP(NAMSPC,"RUNNING",WHEN)))
S LN=LN+1
S TMP(NAMSPC,LN)=""
S LN=LN+1
S TMP(NAMSPC,LN)="Current Counts: "
S LN=LN+1
S TMP(NAMSPC,LN)=" Total File #408.31 Records Processed: "_READ
S LN=LN+1
S TMP(NAMSPC,LN)=" Total Links Corrected: "_CHANGED
S LN=LN+1
S TMP(NAMSPC,LN)=""
S LN=LN+1
S TMP(NAMSPC,LN)="Cleaned up records are referenced in ^XTMP("""_NAMSPC_""",""LINK_DELETED"" global"
S LN=LN+1
S TMP(NAMSPC,LN)=""
D ^XMD
Q
;
YR(IVM) ; Return year of the means test
Q $E($P($G(^DGMT(408.31,+IVM,0)),U),1,3)
;
STOP(CT1) ; Check if asked to stop
; Only check if tasked and every 6000 records read
Q:$S('$G(ZTSK):1,1:CT1#6000) 0
N X
S X=$$S^%ZTLOAD
I X S ZTSTOP=1
Q $G(ZTSTOP)
;
NAMSPC() ;
Q "DG53661"
;
CTSTART ; Restart copay test invalid link
N NAMSPC,ZTDESC,ZTDTH,ZTRTN,ZTSK
S NAMSPC=$$NAMSPC,$P(^XTMP(NAMSPC,"PARAMS"),U,4)=""
S ZTRTN="CTLINKS^DG53661P("_NAMSPC_")"
S ZTDESC="DG*5.3*661 Cleanup Invalid MT/CT Links Process Restart"
S ZTIO="",ZTDTH=$$NOW^XLFDT
D ^%ZTLOAD
W !,"TASK # IS: ",$G(ZTSK)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53661P 4185 printed Dec 13, 2024@02:38:12 Page 2
DG53661P ; ALB/TK,LBD - DG*5.3*661 POST INSTALL CONVERSION ROUTINE ; 5/18/10 1:11pm
+1 ;;5.3;Registration;**661**;Aug 13, 1993;Build 5
+2 ;
EN ; Entry point for post installation routine DG*5.3*661
+1 NEW NAMSPC,ZTDESC,ZTDTH,ZTRTN,ZTSK
+2 SET NAMSPC=$$NAMSPC
+3 SET ZTRTN="CTLINKS^DG53661P("""_NAMSPC_""")"
+4 SET ZTDESC="DG*5.3*661 Cleanup Invalid MT/CT Links"
+5 SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT
+6 DO ^%ZTLOAD
+7 DO BMES^XPDUTL("Cleanup Invalid MT/CT Links Process started - task #"_$GET(ZTSK))
+8 QUIT
+9 ;
CTLINKS(NAMSPC) ; entry for clearing invalid Rx copay test links
+1 NEW CT,CT1,DA,DFN,DIE,DR,IVM,IVMCT,IVMNOW,X,Y,Z
+2 IF '$DATA(^XTMP(NAMSPC))
Begin DoDot:1
+3 SET ^XTMP(NAMSPC,0)=$$FMADD^XLFDT(DT,180)_U_DT_U_"CLEAN UP INVALID MEANS TEST/COPAY TEST LINKS"
SET ^XTMP(NAMSPC,"PARAMS")=""
End DoDot:1
+4 SET Z=$GET(^XTMP(NAMSPC,"PARAMS"))
+5 IF $PIECE(Z,U,4)="RUNNING"
Begin DoDot:1
+6 SET ^XTMP(NAMSPC,"RUNNING",$$NOW^XLFDT)="UPDATE ALREADY RUNNING"
+7 DO BULL(NAMSPC,,,,"RUNNING")
End DoDot:1
QUIT
+8 IF $PIECE(Z,U,4)="DONE"
Begin DoDot:1
+9 SET ^XTMP(NAMSPC,"RUNNING",$$NOW^XLFDT)="UPDATE ALREADY COMPLETE"
+10 DO BULL(NAMSPC,,,,"DONE")
End DoDot:1
QUIT
+11 SET $PIECE(^XTMP(NAMSPC,"PARAMS"),U,4)="RUNNING"
+12 SET IVMNOW=$$NOW^XLFDT
SET ^XTMP(NAMSPC,"RUNNING",IVMNOW)=""
SET ^XTMP(NAMSPC,"RUNNING",IVMNOW,+$GET(ZTSK))=""
+13 SET CT=+Z
SET IVM=+$PIECE(Z,U,2)
SET CT1=+$PIECE(Z,U,3)
+14 FOR
SET IVM=$ORDER(^DGMT(408.31,IVM))
if 'IVM
QUIT
Begin DoDot:1
+15 SET IVMCT=$PIECE($GET(^DGMT(408.31,IVM,2)),U,6)
if $$STOP(CT1)
QUIT
SET CT1=CT1+1
SET $PIECE(^XTMP(NAMSPC,"PARAMS"),U,2,3)=IVM_U_CT1
+16 SET DFN=+$PIECE($GET(^DGMT(408.31,IVM,0)),U,2)
+17 ; Check for copay test for same income year as means test
IF IVMCT
Begin DoDot:2
+18 ; OK if years match
+19 IF $$YR(IVM)=$$YR(IVMCT)
QUIT
+20 ; Delete link to income test in a different income year
+21 SET DA=IVM
SET DIE="^DGMT(408.31,"
SET DR="2.06///@"
+22 DO ^DIE
+23 SET CT=CT+1
SET $PIECE(^XTMP(NAMSPC,"PARAMS"),U,1)=CT
+24 SET ^XTMP(NAMSPC,"LINK_DELETED",IVM,IVMCT)=""
End DoDot:2
End DoDot:1
+25 SET $PIECE(^XTMP(NAMSPC,"PARAMS"),U,4)=$SELECT('$GET(ZTSTOP):"DONE",1:"STOPPED")
SET ^XTMP(NAMSPC,"RUNNING",IVMNOW)=$$NOW^XLFDT
+26 DO BULL(NAMSPC,CT,CT1,IVMNOW,'$GET(ZTSTOP))
+27 QUIT
+28 ;
BULL(NAMSPC,CHANGED,READ,WHEN,DONE) ; Send bulletin
+1 NEW LN,TMP,XMDUZ,XMSUB,XMTEXT,XMY
+2 SET XMY(DUZ)=""
SET XMY("G.DGEN ELIGIBILITY ALERT")=""
SET XMDUZ=.5
SET XMTEXT="TMP("""_NAMSPC_""","
+3 ; Set up copay test 'links' deleted bulletin
+4 SET XMSUB=NAMSPC_": COPAY TEST LINK CLEANUP - SUMMARY REPORT"
+5 SET LN=1
+6 SET TMP(NAMSPC,LN)=""
+7 SET LN=LN+1
+8 SET TMP(NAMSPC,LN)="COPAY TEST INVALID LINK UPDATE RESULTS"
+9 SET LN=LN+1
+10 SET TMP(NAMSPC,LN)="--------------------------------------"
+11 SET LN=LN+1
+12 SET TMP(NAMSPC,LN)=""
+13 IF DONE="RUNNING"
Begin DoDot:1
+14 SET LN=LN+1
+15 SET TMP(NAMSPC,LN)="Sorry, a copay test link clean up is already running."
+16 SET LN=LN+1
+17 SET TMP(NAMSPC,LN)=""
+18 DO ^XMD
End DoDot:1
QUIT
+19 IF DONE="DONE"
Begin DoDot:1
+20 SET LN=LN+1
+21 SET TMP(NAMSPC,LN)="Sorry, the copay test link clean up has already completed."
+22 SET LN=LN+1
+23 SET TMP(NAMSPC,LN)=""
+24 DO ^XMD
End DoDot:1
QUIT
+25 SET LN=LN+1
+26 SET TMP(NAMSPC,LN)="The cleanup has "_$SELECT(DONE:"run to completion",1:"finished a partial run")_". Here are the results"_$SELECT(DONE:"",1:" to date")_":"
+27 SET LN=LN+1
+28 SET TMP(NAMSPC,LN)=""
+29 SET LN=LN+1
+30 SET TMP(NAMSPC,LN)=" Start Date/Time: "_$$FMTE^XLFDT(WHEN)
+31 SET LN=LN+1
+32 SET TMP(NAMSPC,LN)=" End Date/Time: "_$$FMTE^XLFDT($GET(^XTMP(NAMSPC,"RUNNING",WHEN)))
+33 SET LN=LN+1
+34 SET TMP(NAMSPC,LN)=""
+35 SET LN=LN+1
+36 SET TMP(NAMSPC,LN)="Current Counts: "
+37 SET LN=LN+1
+38 SET TMP(NAMSPC,LN)=" Total File #408.31 Records Processed: "_READ
+39 SET LN=LN+1
+40 SET TMP(NAMSPC,LN)=" Total Links Corrected: "_CHANGED
+41 SET LN=LN+1
+42 SET TMP(NAMSPC,LN)=""
+43 SET LN=LN+1
+44 SET TMP(NAMSPC,LN)="Cleaned up records are referenced in ^XTMP("""_NAMSPC_""",""LINK_DELETED"" global"
+45 SET LN=LN+1
+46 SET TMP(NAMSPC,LN)=""
+47 DO ^XMD
+48 QUIT
+49 ;
YR(IVM) ; Return year of the means test
+1 QUIT $EXTRACT($PIECE($GET(^DGMT(408.31,+IVM,0)),U),1,3)
+2 ;
STOP(CT1) ; Check if asked to stop
+1 ; Only check if tasked and every 6000 records read
+2 if $SELECT('$GET(ZTSK)
QUIT 0
+3 NEW X
+4 SET X=$$S^%ZTLOAD
+5 IF X
SET ZTSTOP=1
+6 QUIT $GET(ZTSTOP)
+7 ;
NAMSPC() ;
+1 QUIT "DG53661"
+2 ;
CTSTART ; Restart copay test invalid link
+1 NEW NAMSPC,ZTDESC,ZTDTH,ZTRTN,ZTSK
+2 SET NAMSPC=$$NAMSPC
SET $PIECE(^XTMP(NAMSPC,"PARAMS"),U,4)=""
+3 SET ZTRTN="CTLINKS^DG53661P("_NAMSPC_")"
+4 SET ZTDESC="DG*5.3*661 Cleanup Invalid MT/CT Links Process Restart"
+5 SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT
+6 DO ^%ZTLOAD
+7 WRITE !,"TASK # IS: ",$GET(ZTSK)
+8 QUIT
+9 ;
