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

XUPCSRVR.m

Go to the documentation of this file. 
  1. XUPCSRVR ;OAK/BT- SERVER TO UPDATE THE PERSON CLASS(#8932.1) FILE ;12/05/13
  1.  ;;8.0;KERNEL;**634**;Jul 10, 1995;Build 8
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  Q
  1.  ;Auto update Person Class file. The updated message is sent out from the Person Class master file on Forum
  1. S1 ;get data from email; this starting point for SERVER OPTION. [XUPCSRVR] UPDATE PERSON CLASS SERVER
  1.  K ^TMP("PSC DATA",$J)
  1.  K ^TMP("XUBA",$J)
  1.  N XUI,XUDATA,XUIEN,XUY,XUSBJ
  1.  S XUY=0
  1.  S XUSBJ=$G(^XMB(3.9,XQMSG,0)) I $E(XUSBJ,1,24)'="UPDATE PERSON CLASS ENTR" Q
  1.  S XUI=.99 F  S XUI=$O(^XMB(3.9,XQMSG,2,XUI)) Q:XUI'>0  D
  1.  . S XUDATA=$G(^XMB(3.9,XQMSG,2,XUI,0))
  1.  . S XUIEN=$P(XUDATA,"$$")
  1.  . S XUDATA=$P(XUDATA,"$$",2)
  1.  . S ^TMP("PSC DATA",$J,XUI)=XUDATA
  1.  . I $P(XUDATA,":")="DAT" S XUDATA=$P(XUDATA,":",2) I $P(XUDATA,"^")=XUIEN D ADD(XUDATA) Q  ; update entry
  1.  . I $P(XUDATA,":")="DEF" S XUY=XUY+1,^TMP("XUBA",$J,XUIEN,XUY,0)=$P(XUDATA,":",2,99) Q
  1.  . I $P(XUDATA,":")="END" D DEFI(XUIEN) S XUY=0 Q  ; update definition
  1.  . Q
  1.  D SEND("SUMMARY UPDATE OF THE PERSON CLASS FILE") ;send the updated information to the mail group PERSON CLASS UPDATE
  1.  K XQMSGP
  1.  Q
  1.  ;
  1.  ;-----------------------------------
  1. ADD(XUDATA) ; add or update a single entry
  1.  N FDA,FDAIEN,XUD
  1.  S XUD=$G(XUDATA)
  1.  S FDAIEN(1)=$P(XUD,"^")
  1.  S FDA(8932.1,"+1,",.01)=$P(XUD,"^",2)
  1.  S FDA(8932.1,"+1,",1)=$P(XUD,"^",3)
  1.  S FDA(8932.1,"+1,",2)=$P(XUD,"^",4)
  1.  S FDA(8932.1,"+1,",3)=$P(XUD,"^",5)
  1.  S FDA(8932.1,"+1,",5)=$P(XUD,"^",6)
  1.  S FDA(8932.1,"+1,",5)=$P(XUD,"^",7)
  1.  S FDA(8932.1,"+1,",6)=$P(XUD,"^",8)
  1.  S FDA(8932.1,"+1,",8)=$P(XUD,"^",10)
  1.  S FDA(8932.1,"+1,",90002)=$P(XUD,"^",12)
  1.  ;----------------
  1.  F  L +^USC(8932.1,FDAIEN(1),0):$S($D(DILOCKTM):DILOCKTM,1:3) Q:$T  H $S($D(DILOCKTM):DILOCKTM,1:3)
  1.  D DEL(+XUDATA) ;clean the entry before update 
  1.  D UPDATE^DIE("","FDA","FDAIEN","ERR")
  1.  L -^USC(8932.1,FDAIEN(1),0)
  1.  Q
  1.  ;------------------------------------
  1. DEL(XUIEN)  ;delete entry
  1.  N DIR,DA,DIK
  1.  S DA=$G(XUIEN)
  1.  S DIK="^USC(8932.1," D ^DIK
  1.  Q
  1.  ;
  1.  ;^USC(8932.1,D0,0)= (#.01) PROVIDER TYPE [1F] ^ (#1) CLASSIFICATION [2F] ^ 
  1.  ;                ==>(#2) AREA OF SPECIALIZATION [3F] ^ (#3) STATUS [4S] ^ (#4) 
  1.  ;                ==>DATE INACTIVATED [5D] ^ (#5) VA CODE [6F] ^ (#6) X12 CODE 
  1.  ;                ==>[7F] ^ (#7) reserved [8F] ^ (#8) SPECIALTY CODE [9F] ^ 
  1.  ;^USC(8932.1,D0,11,0)=^8932.111^^  (#11) DEFINITION
  1.  ;^USC(8932.1,D0,11,D1,0)= (#.01) DEFINITION [1W] ^ 
  1.  ;^USC(8932.1,D0,90002)=  ^ (#90002) INDIVIDUAL/NON [2S] ^
  1.  ;------------------------------------
  1.  ;
  1. DEFI(XUIEN) ; 
  1.  N XUI
  1.  S XUI=XUIEN_","
  1.  D WP^DIE(8932.1,XUI,11,"K","^TMP(""XUBA"",$J,XUIEN)")
  1.  K ^TMP("XUBA",$J)
  1.  Q
  1.  ;------------------------------------
  1. SEND(XUKIND) ; Send to sites
  1.  N ODUZ S MSG=$NA(^TMP("PSC DATA",$J))
  1.  I DUZ<.5 S ODUZ=DUZ,DUZ=.5 ;** Change user to POSTMASTER **
  1.  S MSGSBJ=$G(XUKIND)_"   "_$$FMTE^XLFDT(DT,1)
  1.  I '$D(WHO) S WHO("G.PERSON CLASS UPDATE")=""
  1.  D SENDMSG^XMXAPI(DUZ,MSGSBJ,.MSG,.WHO)
  1.  K ^TMP("PSC DATA",$J),MSGSBJ,MSG
  1.  Q
  1.  ;
  1. CRMG ;CREATE MAIL GROUP
  1.  ;N XMY S XMY(DUZ)=""
  1.  N XMDESC S XMDESC(1)="This mail group is to receive updated Person Class messages from the Master Person Class file from Forum account."
  1.  N XUIEN S XUIEN=$$MG^XMBGRP("PERSON CLASS UPDATE",0,.5,1,,.XMDESC,1)
  1.  Q
  1.  ;
  1. DEF ; Update definitions
  1.  N XUI D DEF1(609)
  1.  N XUI D DEF1(610)
  1.  N XUI D DEF1(745)
  1.  Q
  1.  ;
  1. DEF1(XUI) ; Update definition for single entry XUI
  1.  N XUI1,XUDATA,XUY
  1.  K ^TMP($J,"XUBA")
  1.  F XUY=1:1:100 S XUDATA=$T(@XUI+XUY) Q:XUDATA=" ;;END"  D 
  1.  . S ^TMP($J,"XUBA",XUI,XUY,0)=$P(XUDATA,";;",2)
  1.  S XUI1=XUI_","
  1.  D WP^DIE(8932.1,XUI1,11,"K","^TMP($J,""XUBA"",XUI)")
  1.  K ^TMP($J,"XUBA")
  1.  Q
  1.  ;
  1. GETDEF ; get definitions
  1.  N XUI,XUY
  1.  F XUI=609,610,745 D
  1.  . S XUY=$G(^USC(8932.1,XUI,11,0)),XUY=$P(XUY,"^",3)
  1.  . I XUY>0 D GETDES(XUI,XUY)
  1.  Q
  1.  ;
  1. GETDES(XUI,XUY) ; get single entry definition
  1.  N XUA,XUB
  1.  W !,XUI," ;"
  1.  F XUA=1:1:XUY W !," ;;",$G(^USC(8932.1,XUI,11,XUA,0))
  1.  W !," ;;END"
  1.  Q
  1.  ;
  1. POST ;
  1.  D DEF ; Update for 30/1/2013
  1.  D CRMG ;CREATE MAIL GROUP
  1.  Q
  1.  ;
  1. 609 ;
  1.  ;;A health care professional who is specifically educated and trained to 
  1.  ;;manage comprehensive orthotic patient care, including musculoskeletal and 
  1.  ;;neuromuscular anomalies resulting from injuries or disease processes 
  1.  ;;involving the lower extremity, upper extremity or spinal segment/s and 
  1.  ;;positional deformation of the cranium. Orthotists assess specific patient 
  1.  ;;needs, formulate an appropriate treatment plan, implement the treatment 
  1.  ;;plan and provide follow-up care.   Source: American Board for 
  1.  ;;Certification in Orthotics, Prosthetics, and Pedorthics, Inc. [7/1/2010: 
  1.  ;;modified, 7/1/2013: modified]
  1.  ;; 
  1.  ;;Additional Resources: American Board for Certification in Orthotics, 
  1.  ;;Prosthetics and Pedorthics, Inc., www.abcop.org and Board of 
  1.  ;;Certification/Accreditation, International, www.bocusa.org.
  1.  ;;END
  1. 610 ;
  1.  ;;A health care professional who is specifically educated and trained to 
  1.  ;;manage comprehensive prosthetic patient care for individuals who have 
  1.  ;;sustained complete or partial limb loss or absence. Prosthetists assess 
  1.  ;;specific patient needs, formulate an appropriate treatment plan, 
  1.  ;;implement the treatment plan and provide follow-up care.   Source: 
  1.  ;;American Board for Certification in Orthotics, Prosthetics, and 
  1.  ;;Pedorthics, Inc. [7/1/2010: modified, 7/1/2013: modified]
  1.  ;; 
  1.  ;;Additional Resources: American Board for Certification in Orthotics, 
  1.  ;;Prosthetics and Pedorthics, Inc., www.abcop.org and Board of 
  1.  ;;Certification/Accreditation, International, www.bocusa.org.
  1.  ;;END
  1. 745 ;
  1.  ;;Oral and maxillofacial surgeons are trained to recognize and treat a wide 
  1.  ;;spectrum of diseases, injuries and defects in the head, neck, face, jaws 
  1.  ;;and the hard and soft tissues of the oral and maxillofacial region. They 
  1.  ;;are also trained to administer anesthesia, and provide care in an office 
  1.  ;;setting. They are trained to treat problems such as the extraction of 
  1.  ;;wisdom teeth, misaligned jaws, tumors and cysts of the jaw and mouth, and 
  1.  ;;to perform dental implant surgery.   Source: American College of 
  1.  ;;Surgeons, 2013. [7/1/2013: definition added, source added, additional 
  1.  ;;resources added]
  1.  ;; 
  1.  ;;Additional Resources: American Board of Oral and Maxillofacial Surgery 
  1.  ;;and American Association of Oral and Maxillofacial Surgeons
  1.  ;; 
  1.  ;;While this is generally considered a specialty of dentistry, physicians 
  1.  ;;can also be board certified as oral and maxillofacial surgeons through 
  1.  ;;the American Board of Oral and Maxillofacial Surgery.
  1.  ;;END