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

SD53239P.m

Go to the documentation of this file.
  1. SD53239P ;BPFO/JRP - PRE/POST INIT ROUTINE;5/29/2001
  1. ;;5.3;Scheduling;**239**;Aug 13, 1993
  1. ;
  1. ;The bulk of this routine was copied from routine SD53142
  1. ;
  1. PRE ;Main entry point for pre init
  1. ;Remove ERROR CODE DESCRIPTION (field #11) as an identifier of the
  1. ; TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE file (#409.76)
  1. ; (this causes problems when installing error codes)
  1. I ($D(^DD(409.76,0,"ID",11))) D
  1. .N TMP,X
  1. .S X(1)=" "
  1. .S X(2)="Removing ERROR CODE DESCRIPTION (field #11) as an identifier"
  1. .S X(3)="of the TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE file"
  1. .S X(4)="(#409.76) as it causes problems when installing error codes."
  1. .S X(5)=" "
  1. .D MES^XPDUTL(.X) K X
  1. .K ^DD(409.76,0,"ID",11)
  1. .Q:($D(^DD(409.76,0,"ID")))
  1. .S TMP=$P(^SD(409.76,0),U,2)
  1. .S TMP=$TR(TMP,"I","")
  1. .S $P(^SD(409.76,0),U,2)=TMP
  1. .Q
  1. Q
  1. ;
  1. POST ;Main entry point of post init
  1. N X,ZTRTN,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTSK
  1. ;Make ERROR CODE DESCRIPTION (field #11) an identifier of the
  1. ; TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE file (#409.76)
  1. ; (this was removed by the pre init routine)
  1. I ('$D(^DD(409.76,0,"ID",11))) D
  1. .N TMP
  1. .S X(1)=" "
  1. .S X(2)="Restoring ERROR CODE DESCRIPTION (field #11) as an identifier"
  1. .S X(3)="of the TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE file"
  1. .S X(4)="(#409.76) as it was removed by the pre init."
  1. .S X(5)=" "
  1. .D MES^XPDUTL(.X) K X
  1. .S ^DD(409.76,0,"ID",11)="D EN^DDIOL($P(^(1),U,1))"
  1. .S TMP=$P(^SD(409.76,0),U,2)
  1. .S TMP=$TR(TMP,"I","")
  1. .S $P(^SD(409.76,0),U,2)=TMP_"I"
  1. ;Change HL7 application name
  1. D HLAPP("AMBCARE-DH142","AMBCARE-DH239")
  1. ;Queue changing of HL7 message statuses
  1. S ZTRTN="QHLM^SD53239P"
  1. S ZTDESC="Change status of unacked AmbCare messages to SUCCESSFULLY COMPLETED"
  1. S ZTIO=""
  1. S ZTDTH=$H
  1. D ^%ZTLOAD
  1. K X
  1. S X(1)=" "
  1. S X(2)="Updating status of AmbCare messages that have not been acknowledged"
  1. S X(3)="queued as task number "_$G(ZTSK)
  1. S X(4)=" "
  1. I '$G(ZTSK) D
  1. .S X(1)=" "
  1. .S X(2)="***** Updating status of AmbCare messages that have not been"
  1. .S X(3)="***** acknowledged was not queued. This process must be done"
  1. .S X(4)="***** in order for these messages to be properly purged."
  1. .S X(5)="***** Use entry point QHLM^SD53239P to do this process."
  1. .S X(6)=" "
  1. D MES^XPDUTL(.X) K X
  1. Q
  1. ;
  1. HLAPP(OLDNAME,NEWNAME) ;Change HL7 application name
  1. ;Input : OLDNAME - Name of HL7 application to change
  1. ; NEWNAME - New name for HL7 application
  1. ;Output : None
  1. ;Notes : Call designed to be used as a KIDS pre/post init
  1. S OLDNAME=$G(OLDNAME) Q:OLDNAME=""
  1. S NEWNAME=$G(NEWNAME) Q:NEWNAME=""
  1. N DIE,DIC,DA,DR,X,Y
  1. D BMES^XPDUTL("Changing HL7 Application name from "_OLDNAME_" to "_NEWNAME)
  1. S DIC="^HL(771,"
  1. S DIC(0)="X"
  1. S X=OLDNAME
  1. D ^DIC
  1. I (Y<0) D Q
  1. .D BMES^XPDUTL(" *** "_OLDNAME_" application not found ***")
  1. S DIE=DIC
  1. S DA=+Y
  1. S DR=".01///^S X=NEWNAME"
  1. D ^DIE
  1. D MES^XPDUTL("HL7 application name successfully changed to "_NEWNAME)
  1. Q
  1. ;
  1. QHLM ;Entry point for queued changing of HL7 messages
  1. D HLM("AMBCARE-DH239")
  1. Q
  1. HLM(APPNAME) ;Change status of HL7 messages to '3' (SUCCESSFULLY COMPLETED)
  1. ; to enable purging of message
  1. ;Input : APPNAME - Name of application generating message
  1. ;Output : None
  1. ;Notes : Call must be used within KIDS (updates progress bar)
  1. S APPNAME=$G(APPNAME) Q:APPNAME=""
  1. N DA,DIC,DIE,DR,X,Y,SDAPP,HLMID,XPDIDTOT,HLPTR,COUNT,TEXT
  1. N XMDUZ,XMSUB,XMTEXT,XMY,XMZ
  1. K ^TMP("SD53239P",$J)
  1. S X=$$NOW^XLFDT()
  1. S Y=$$FMTE^XLFDT(X)
  1. S TEXT="Updating of HL7 Message Text file (#772) began on "
  1. S TEXT=TEXT_$P(Y,"@",1)_" @ "_$P(Y,"@",2)
  1. S ^TMP("SD53239P",$J,1,0)=TEXT
  1. S DIC="^HL(771,"
  1. S DIC(0)="M"
  1. S X=APPNAME
  1. D ^DIC
  1. I (Y<0) D G HLMQ
  1. .S ^TMP("SD53239P",$J,2,0)=" *** "_APPNAME_" application not found"
  1. .S ^TMP("SD53239P",$J,3,0)=" *** Process aborted"
  1. S SDAPP=+Y
  1. S HLMID=""
  1. S COUNT=0
  1. F S HLMID=$O(^HL(772,"AH",SDAPP,HLMID)) Q:(HLMID="") D
  1. .S HLPTR=0
  1. .F S HLPTR=+$O(^HL(772,"AH",SDAPP,HLMID,HLPTR)) Q:('HLPTR) D
  1. ..S DIE="^HL(772,"
  1. ..S DA=HLPTR
  1. ..S DR="20////3"
  1. ..D ^DIE
  1. ..S COUNT=COUNT+1
  1. S X=$$NOW^XLFDT()
  1. S Y=$$FMTE^XLFDT(X)
  1. S TEXT="Updating of HL7 Message Text file completed on "
  1. S TEXT=TEXT_$P(Y,"@",1)_" @ "_$P(Y,"@",2)
  1. S ^TMP("SD53239P",$J,2,0)=TEXT
  1. S ^TMP("SD53239P",$J,3,0)=COUNT_" entries were updated"
  1. HLMQ S XMDUZ="Patch SD*5.3*239"
  1. S XMSUB="Updating of HL7 Message Text file"
  1. S XMTEXT="^TMP(""SD53239P"",$J,"
  1. S XMY(DUZ)=""
  1. D ^XMD
  1. S ZTREQ="@"
  1. Q