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

DG53P733.m

Go to the documentation of this file.
DG53P733 ;ALB/AMA,GTS - PATCH DG*5.3*733 POST-INSTALL ROUTINE
 ;;5.3;Registration;**733,1015**;Aug 13, 1993;Build 21
 ;
EN ;
 N ZTDTH,ZTIO,ZTDESC,ZTRTN,ZTSAVE,ZTSK
 S ZTDTH=$H
 S ZTIO=""
 S ZTDESC="DG*5.3*733 Post-Install message"
 S ZTRTN="CLEANUP^DG53P733"
 S ZTSAVE("DUZ")=""
 S ZTSAVE("JVAL")=$J
 D ^%ZTLOAD
 I $G(ZTSK) DO
 . D BMES^XPDUTL("POST-INSTALL CLEANUP MESSAGE QUEUED TO SEND")
 . D BMES^XPDUTL("Means Test database cleanup has been completed.  Check your VA Mailman")
 . D MES^XPDUTL("mailbox for the ""DG*5.3*733 External value cleanup"" message.")
 . D BMES^XPDUTL("Only if you do not receive the e-mail, check the following global:")
 . D MES^XPDUTL("  ^XTMP(""DG"","_$J_",""PATCH 733 CLEANUP BULLETIN"")")
 I '$G(ZTSK) D BMES^XPDUTL("PROBLEM: POST-INSTALL CLEANUP MESSAGE NOT SENT")
 Q
CLEANUP ;
 N JVAL,DGMMLNE,DFN,FIRST,RECCNT
 S JVAL=$J
 ;*Create bulletin head to identify cleanup records
 K ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN")
 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",1)="This message indicates the patients in the PATIENT file (2)"
 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",2)="that have had the COMBAT INDICATED ON 1010EZ field (1010.157)"
 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",3)="populated to the correct YES, NO or NULL value."
 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",4)=" "
 ;
 S DGMMLNE=4
 ;
 ;*Set up message text
 S DGMMLNE=DGMMLNE+1
 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)="Checking COMBAT INDICATED ON 1010EZ field (1010.157) in PATIENT file (2)..."
 S DGMMLNE=DGMMLNE+1
 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)=" "
 ;
 ;Execute COMBAT INDICATED ON 1010EZ field conversion
 S FIRST=1,RECCNT=0
 S DFN=0 F  S DFN=$O(^DPT(DFN)) Q:'DFN  D
 . Q:'$D(^DPT(DFN,.52))
 . N NODE52,NODE1010 S NODE52=$G(^DPT(DFN,.52)),NODE1010=$G(^DPT(DFN,1010.15))
 . I ($P(NODE52,U,11)=""),($P(NODE1010,U,7)'="") D  Q
 . . S $P(^DPT(DFN,1010.15),U,7)=""
 . . D ADDLINE("NULL")
 . I ($P(NODE52,U,11)="N"),($P(NODE1010,U,7)'=0) D  Q
 . . S $P(^DPT(DFN,1010.15),U,7)=0
 . . D ADDLINE("NO")
 . I ($P(NODE52,U,11)="Y"),($P(NODE52,U,14)'>2981111),($P(NODE1010,U,7)'=0) D  Q
 . . S $P(^DPT(DFN,1010.15),U,7)=0
 . . D ADDLINE("NO")
 . I ($P(NODE52,U,11)="Y"),($P(NODE52,U,14)>2981111),($P(NODE1010,U,7)'=1) D  Q
 . . S $P(^DPT(DFN,1010.15),U,7)=1
 . . D ADDLINE("YES")
 ;
 S DGMMLNE=DGMMLNE+1
 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)=" "
 S DGMMLNE=DGMMLNE+1
 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)="There were "_RECCNT_" records corrected."
 S DGMMLNE=DGMMLNE+1
 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)=" "
 ;
 ;* Queue message to be sent
 D SENDMESS
 Q
ADDLINE(MSG) ;
 I FIRST D FIRST S FIRST=0
 S DGMMLNE=DGMMLNE+1,RECCNT=RECCNT+1
 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)="  IEN:  "_DFN_"    COMBAT INDICATED ON 1010EZ changed to:  "_MSG
 Q
FIRST ;
 S DGMMLNE=DGMMLNE+1
 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)="The COMBAT INDICATED ON 1010EZ field (#1010.157) for the following Patient"
 S DGMMLNE=DGMMLNE+1
 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)="file (#2) IENs were modified:"
 S DGMMLNE=DGMMLNE+1
 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)=" "
 Q
SENDMESS ;
 N XMSUB,XMDUZ,XMTEXT,XMY,XMMG
 S XMSUB="DG*5.3*733 COMBAT INDICATED ON 1010EZ cleanup"
 S XMDUZ="DG*5.3*733 Install Cleanup"
 S XMTEXT="^XTMP(""DG"",JVAL,""PATCH 733 CLEANUP BULLETIN"","
 S XMY(DUZ)=""
 S XMY(.5)=""
 D ^XMD
 S DGMMLNE=$P($$FMADD^XLFDT($$NOW^XLFDT,,,5),".")
 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",0)=DGMMLNE
 I '$D(XMMG) K ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN")
 Q