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

DG53461U.m

Go to the documentation of this file.
  1. DG53461U ;ALB/AEG - DG*5.3*461 POST INSTALL UTILS ;7-3-02
  1. ;;5.3;Registration;**461,1015**;Aug 13, 1993;Build 21
  1. ;
  1. MESS ; Setup initial message array for users
  1. S MESS(1)="This post-installation will search the CD STATUS PROCECURES subfile (#.397)"
  1. S MESS(2)="of the PATIENT file (#2) to find those patients who have duplicate procedure"
  1. S MESS(3)="codes associated with the same extremity. The duplicate entries will be purged"
  1. S MESS(4)="from the CD STATUS PROCEDURES subfile (#.397). A report will be generated"
  1. S MESS(5)="via mailman to identify the patient and the data values of the duplicate"
  1. S MESS(6)="procedures and associated extremities purged from the database."
  1. S MESS(7)=" "
  1. Q
  1. M1 ; Send mail message if no duplicate data to be cleaned up by the patch.
  1. ;
  1. S ^TMP($J,1)="No duplicate CD procedure codes found in your database."
  1. N DIFROM,%,XMDUZ,XMSUB,XMTEXT,XMY,Y
  1. S XMSUB="DG*5.3*461 POST INSTALL REPORT"
  1. S XMY(DUZ)="",XMY(.5)="",XMDUZ="REGISTRATION PACKAGE"
  1. S XMTEXT="^TMP($J,"
  1. D ^XMD
  1. D BMES^XPDUTL("Post-Install Message <"_XMZ_"> sent.")
  1. K ^TMP($J)
  1. Q
  1. ;
  1. M2 ; Setup mail message to report patient data/procedure data of purged
  1. ; data to users.
  1. I '$D(^UTILITY($J,"DUP")) Q
  1. S ^TMP($J,1)="The following patients had duplicate CD procedures in the CD STATUS PROCEDURES"
  1. S ^TMP($J,2)="subfile (#.397) of the PATIENT file (#2). The duplicate procedures have been"
  1. S ^TMP($J,3)="purged from your database."
  1. S ^TMP($J,4)=" "
  1. S ^TMP($J,5)=$$BLDSTR("PATIENT NAME","LAST 4","CD PROCEDURE","EXTREMITY")
  1. S ^TMP($J,6)=$$BLDSTR("------------","------","------------","---------")
  1. N NAME,SSN,PROC,EXT,AJ,DFN,PCODE,COUNTER,N1
  1. S NAME="",COUNTER=6,N1=""
  1. F AJ=7:1 S NAME=$O(^UTILITY($J,"DUP",NAME)) Q:NAME="" S DFN=0 F S DFN=$O(^UTILITY($J,"DUP",NAME,DFN)) Q:'+DFN D
  1. .S SSN=$E($P($G(^DPT(DFN,0)),U,9),6,9)
  1. .S N1=NAME
  1. .S PCODE="" F S PCODE=$O(^UTILITY($J,"DUP",NAME,DFN,PCODE)) Q:PCODE="" S COUNTER=COUNTER+1 D
  1. ..S PROC=$P($G(PCODE),"^",1)
  1. ..S PROC=$G(^DGEN(27.17,PROC,0)),PROC=$P($P($G(PROC),U,3),";",1)
  1. ..S EXT=$P($G(PCODE),U,2)
  1. ..I $G(^TMP($J,COUNTER-1))[NAME S (N1,SSN)=""
  1. ..S ^TMP($J,COUNTER)=$$BLDSTR(N1,SSN,PROC,EXT)
  1. ..Q
  1. .Q
  1. N DIFROM,%,XMDUZ,XMSUB,XMTEXT,XMY,Y
  1. S XMSUB="DG*5.3*461 POST INSTALL REPORT"
  1. S XMY(DUZ)="",XMY(.5)="",XMDUZ="REGISTRATION PACKAGE"
  1. S XMTEXT="^TMP($J,"
  1. D ^XMD
  1. D BMES^XPDUTL("Post-Install Message <"_XMZ_"> sent.")
  1. K ^TMP($J),^UTILITY($J)
  1. Q
  1. M3 ; Report any errors to user if duplicate CD STATUS PROCEDURE could not
  1. ; be purged from the system.
  1. N DFN,ERR,NAME,SSN,AK
  1. S ^TMP($J,1)="The following patients have duplicate CD Procedure codes which could not"
  1. S ^TMP($J,2)="be purged from the database due to errors. Please review this list"
  1. S ^TMP($J,3)="and make corrections to the patient's Catastrophic disability as"
  1. S ^TMP($J,4)="necessary."
  1. S ^TMP($J,5)=""
  1. S ^TMP($J,6)=$$BLDSTR("PATIENT NAME","LAST 4","ERROR","")
  1. S ^TMP($J,7)=$$BLDSTR("------------","------","-----","")
  1. N ERR,DFN,SSN
  1. S DFN=""
  1. F AK=8:1 S DFN=$O(^TMP("ERROR",$J,DFN)) Q:'+DFN D
  1. .S NAME=$E($P($G(^DPT(DFN,0)),U,1),1,20)
  1. .S SSN=$E($P($G(^DPT(DFN,0)),U,9),6,9)
  1. .S ERR="" F S ERR=$O(^TMP("ERROR",$J,DFN,ERR)) Q:ERR="" D
  1. ..S ^TMP($J,AK)=$$BLDSTR(NAME,SSN,ERR,"")
  1. ..Q
  1. .Q
  1. N DIFROM,%,XMDUZ,XMTEXT,XMY,Y
  1. S XMSUB="DG*5.3*461 POST INSTALL ERROR REPORT"
  1. S XMY(DUZ)="",XMY(.5)="",XMDUZ="REGISTRATION PACKAGE"
  1. S XMTEXT="^TMP($J,"
  1. D ^XMD
  1. D BMES^XPDUTL("Post-Install Message <"_XMZ_"> sent.")
  1. K ^TMP($J),^UTILITY($J),^TMP("ERROR",$J)
  1. Q
  1. BLDSTR(P1,P2,P3,P4) ; Build a string from input
  1. N S1,S2,S3,S4
  1. S S1=$E(P1,1,20) I $L(S1)'>19 D
  1. .S S1=S1_$J("",(20-$L(S1)))
  1. S S2=P2 I $L(S2)'>6 D
  1. .S S2=S2_$J("",(7-$L(S2)))
  1. S S3=P3 I $L(S3)'>11 D
  1. .S S3=S3_$J("",(12-$L(S3)))
  1. S S4=P4
  1. Q S1_$J("",3)_S2_$J("",5)_S3_$J("",5)_S4