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

KMPDUT2.m

Go to the documentation of this file. 
  1. KMPDUT2 ;OAK/RAK - CM Tools Utility ;2/17/04  10:45
  1.  ;;3.0;KMPD;;Jan 22, 2009;Build 42
  1.  ;
  1. ID(KMPDIEN) ;--called from ^DD(8973.1,0,"ID","W")
  1.  ;-----------------------------------------------------------------------
  1.  ; KMPDIEN... Ien for file #8973.1 (CM HL7 DATA)
  1.  ;-----------------------------------------------------------------------
  1.  Q:'$G(KMPDIEN)
  1.  Q:'$D(^KMPD(8973.1,+KMPDIEN,0))
  1.  N DATA,TXT
  1.  S DATA=$G(^KMPD(8973.1,+KMPDIEN,0)),DATA(99.2)=$G(^(99.2)) Q:DATA=""
  1.  ; sent to national database
  1.  S TXT(1)=$S($P(DATA,U,2):"sent",1:"not sent")
  1.  S TXT(1)=TXT(1)_$J(" ",11-$L(TXT(1)))
  1.  ; namespace
  1.  S TXT(1)=TXT(1)_$P(DATA,U,3)
  1.  S TXT(1)=TXT(1)_$J(" ",18-$L(TXT(1)))
  1.  ; protocol
  1.  S TXT(1)=TXT(1)_$P(DATA,U,5)
  1.  S TXT(1)=TXT(1)_$J(" ",52-$L(TXT(1)))
  1.  ; synch/asynch
  1.  S TXT(1)=TXT(1)_$S($P(DATA,U,6)=1:"sync",1:"async")
  1.  ; other site number
  1.  I $P(DATA(99.2),U,12)'="" D 
  1.  .S TXT(2)=$P(DATA(99.2),U,12)
  1.  .S TXT(2,"F")="!?41"
  1.  S TXT(1,"F")="?15"
  1.  D EN^DDIOL(.TXT)
  1.  Q
  1.  ;
  1. ID1(KMPDIEN) ;--called from ^DD(8973.2,0,"ID","W")
  1.  ;-----------------------------------------------------------------------
  1.  ; KMPDIEN... Ien for file #8973.2 (CM TIMING)
  1.  ;-----------------------------------------------------------------------
  1.  Q:'$G(KMPDIEN)
  1.  Q:'$D(^KMPD(8973.2,+KMPDIEN,0))
  1.  N DATA,TXT
  1.  S DATA=$G(^KMPD(8973.2,+KMPDIEN,0)) Q:DATA=""
  1.  S TXT(1)=""
  1.  ; date/time
  1.  S TXT(1)=TXT(1)_$$FMTE^XLFDT($P(DATA,U,3),2)
  1.  S TXT(1)=TXT(1)_$J(" ",18-$L(TXT(1)))
  1.  ; title
  1.  S TXT(1.1)=$P(DATA,U,8)
  1.  ; client name
  1.  S TXT(2)="client: "_$E($P(DATA,U,6),1,30)
  1.  ; person
  1.  S TXT(3)="pers  : "_$P($G(^VA(200,+$P(DATA,U,5),0)),U)
  1.  ; sent to national database
  1.  S TXT(4)="daily : "_$S($P(DATA,U,10):"sent",1:"not sent")
  1.  ;S TXT(1)=TXT(1)_$J(" ",11-$L(TXT(1)))
  1.  S TXT(1,"F")="?45"
  1.  S TXT(1.1,"F")="!?38"
  1.  S TXT(2,"F")="!?38"
  1.  S TXT(3,"F")="!?38"
  1.  S TXT(4,"F")="!?38"
  1.  D EN^DDIOL(.TXT)
  1.  Q
  1.  ;
  1. XREF(DA,X,KMPDTYPE) ;-set/kill 'APTDTNM' xref in file #8973.1
  1.  ;-----------------------------------------------------------------------
  1.  ; DA....... Ien for file #8973.1 (CM HL7 DATA)
  1.  ; X........ Value of field #.05 (PROTOCOL)
  1.  ; KMPDTYPE. 1 - set xref
  1.  ;           2 - kill xref
  1.  ;-----------------------------------------------------------------------
  1.  Q:'$G(DA)
  1.  Q:$G(X)=""
  1.  Q:'$G(KMPDTYPE)
  1.  N DATA,DATE,NM
  1.  S DATA=$G(^KMPD(8973.1,DA,0)) Q:DATA=""
  1.  S DATE=$P(DATA,U) Q:'DATE
  1.  S NM=$P(DATA,U,3) Q:NM=""
  1.  I KMPDTYPE=1 S ^KMPD(8973.1,"APTDTNM",X,DATE,NM,DA)=""
  1.  I KMPDTYPE=2 K ^KMPD(8973.1,"APTDTNM",X,DATE,NM,DA)
  1.  Q
  1.  ;
  1. XREF1(DA,X,KMPDTYPE) ;-set/kill 'ACSDTPRNM' xref in file #8973.1
  1.  ;-----------------------------------------------------------------------
  1.  ; DA....... Ien for file #8973.1 (CM HL7 DATA)
  1.  ; X........ Value of field #99.212 (CONTACTED SITE NAME)
  1.  ; KMPDTYPE. 1 - set xref
  1.  ;           2 - kill xref
  1.  ;
  1.  ; variables used:
  1.  ; DATE.. Internal value of field #.01 (DATE)
  1.  ; NM.... Internal value of field #.03 (NAMESPACE)
  1.  ; PR.... Internal value of field #.05 (PROTOCOL)
  1.  ;-----------------------------------------------------------------------
  1.  Q:'$G(DA)
  1.  Q:$G(X)=""
  1.  Q:'$G(KMPDTYPE)
  1.  N DATA,DATE,NM,PR
  1.  S DATA=$G(^KMPD(8973.1,DA,0)) Q:DATA=""
  1.  S DATE=$P(DATA,U) Q:'DATE
  1.  S NM=$P(DATA,U,3) Q:NM=""
  1.  S PR=$P(DATA,U,5) Q:PR=""
  1.  I KMPDTYPE=1 S ^KMPD(8973.1,"ACSDTPRNM",X,DATE,PR,NM,DA)=""
  1.  I KMPDTYPE=2 K ^KMPD(8973.1,"ACSDTPRNM",X,DATE,PR,NM,DA)
  1.  Q
  1.  ;
  1. XREF2(DA,X,KMPDTYPE) ;-set/kill 'ASYNC' xref in file #8973.1
  1.  ;-----------------------------------------------------------------------
  1.  ; DA....... Ien for file #8973.1 (CM HL7 DATA)
  1.  ; X........ Value of field #.06 (SYNC/ASYNC)
  1.  ; KMPDTYPE. 1 - set xref
  1.  ;           2 - kill xref
  1.  ;
  1.  ; variables used:
  1.  ; DATE.. Internal value of field #.01 (DATE)
  1.  ;-----------------------------------------------------------------------
  1.  Q:'$G(DA)
  1.  Q:$G(X)=""
  1.  Q:'$G(KMPDTYPE)
  1.  N DATA,DATE
  1.  S DATA=$G(^KMPD(8973.1,DA,0)) Q:DATA=""
  1.  S DATE=$P(DATA,U) Q:'DATE
  1.  I KMPDTYPE=1 S ^KMPD(8973.1,"ASYNC",DATE,X,DA)=""
  1.  I KMPDTYPE=2 K ^KMPD(8973.1,"ASYNC",DATE,X,DA)
  1.  Q
  1.  ;
  1. XREFT1(DA,X,KMPDTYPE) ;-set/kill 'ASVDTSS' xref in file #8973.2
  1.  ;-----------------------------------------------------------------------
  1.  ; DA....... Ien for file #8973.2 (CM TIMING)
  1.  ; X........ Value of field #.07 (SERVER SUBSCRIPT)
  1.  ; KMPDTYPE. 1 - set xref
  1.  ;           2 - kill xref
  1.  ;-----------------------------------------------------------------------
  1.  Q:'$G(DA)
  1.  Q:$G(X)=""
  1.  Q:'$G(KMPDTYPE)
  1.  N DATA,DATE
  1.  S DATA=$G(^KMPD(8973.2,DA,0)) Q:DATA=""
  1.  ; strip off time
  1.  S DATE=$P($P(DATA,U,3),".") Q:'DATE
  1.  I KMPDTYPE=1 S ^KMPD(8973.2,"ASVDTSS",X,DATE,DA)=""
  1.  I KMPDTYPE=2 K ^KMPD(8973.2,"ASVDTSS",X,DATE,DA)
  1.  Q
  1.  ;
  1. XREFT2(DA,X,KMPDTYPE) ;-set/kill 'ASSDTPT' xref in file #8973.2
  1.  ;-----------------------------------------------------------------------
  1.  ; DA....... Ien for file #8973.2 (CM TIMING)
  1.  ; X........ Value of field #.07 (SERVER SUBSCRIPT)
  1.  ; KMPDTYPE. 1 - set xref
  1.  ;           2 - kill xref
  1.  ;
  1.  ; ^KMPD(8973.2,"ASSDTPT",ServerSubscript,ServerStartDate,PrimeTime,DA)
  1.  ;-----------------------------------------------------------------------
  1.  Q:'$G(DA)
  1.  Q:$G(X)=""
  1.  Q:'$G(KMPDTYPE)
  1.  N DATA,DATE,PTNP
  1.  S DATA=$G(^KMPD(8973.2,DA,0)) Q:DATA=""
  1.  ; server start date/time
  1.  S DATE=$P(DATA,U,3) Q:'DATE
  1.  ; prime time / non-prime time
  1.  S PTNP=$$PTNP^KMPDHU03(DATE) Q:'PTNP
  1.  ; strip off time
  1.  S DATE=$P(DATE,".") Q:'DATE
  1.  I KMPDTYPE=1 S ^KMPD(8973.2,"ASSDTPT",X,DATE,PTNP,DA)=""
  1.  I KMPDTYPE=2 K ^KMPD(8973.2,"ASSDTPT",X,DATE,PTNP,DA)
  1.  Q
  1.  ;
  1. XREFT3(DA,X,KMPDTYPE) ;-set/kill 'ASSDTTM' xref in file #8973.2
  1.  ;-----------------------------------------------------------------------
  1.  ; DA....... Ien for file #8973.2 (CM TIMING)
  1.  ; X........ Value of field #.07 (SERVER SUBSCRIPT)
  1.  ; KMPDTYPE. 1 - set xref
  1.  ;           2 - kill xref
  1.  ;
  1.  ; ^KMPD(8973.2,"ASSDTTM",ServerSubscript,ServerStartDate,PrimeTime,DA)
  1.  ;-----------------------------------------------------------------------
  1.  Q:'$G(DA)
  1.  Q:$G(X)=""
  1.  Q:'$G(KMPDTYPE)
  1.  N DATA,DATE
  1.  S DATA=$G(^KMPD(8973.2,DA,0)) Q:DATA=""
  1.  ; server start date/time
  1.  S DATE=$P(DATA,U,3) Q:'DATE
  1.  I KMPDTYPE=1 S ^KMPD(8973.2,"ASSDTTM",X,DATE,DA)=""
  1.  I KMPDTYPE=2 K ^KMPD(8973.2,"ASSDTTM",X,DATE,DA)
  1.  Q
  1.  ;
  1. XREFT4(DA,X,KMPDTYPE) ;-set/kill 'ASSCLDTTM' xref in file #8973.2
  1.  ;-----------------------------------------------------------------------
  1.  ; DA....... Ien for file #8973.2 (CM TIMING)
  1.  ; X........ Value of field #.07 (KMPTMP SUBSCRIPT)
  1.  ; KMPDTYPE. 1 - set xref
  1.  ;           2 - kill xref
  1.  ;
  1.  ; ^KMPD(8973.2,"ASSCLDTTM",KmptmpSubscript,ClientName,ServerDateTime,DA)
  1.  ;-----------------------------------------------------------------------
  1.  Q:'$G(DA)
  1.  Q:$G(X)=""
  1.  Q:'$G(KMPDTYPE)
  1.  N CLNM,DATA,DATE
  1.  S DATA=$G(^KMPD(8973.2,DA,0)) Q:DATA=""
  1.  ; server start date/time
  1.  S DATE=$P(DATA,U,3) Q:'DATE
  1.  ; client name
  1.  S CLNM=$P(DATA,U,6) Q:CLNM=""
  1.  I KMPDTYPE=1 S ^KMPD(8973.2,"ASSCLDTTM",X,CLNM,DATE,DA)=""
  1.  I KMPDTYPE=2 K ^KMPD(8973.2,"ASSCLDTTM",X,CLNM,DATE,DA)
  1.  Q
  1. XREFT5(DA,X,KMPDTYPE) ;-set/kill 'ASSNPDTTM' xref in file #8973.2
  1.  ;-----------------------------------------------------------------------
  1.  ; DA....... Ien for file #8973.2 (CM TIMING)
  1.  ; X........ Value of field #.07 (KMPTMP SUBSCRIPT)
  1.  ; KMPDTYPE. 1 - set xref
  1.  ;           2 - kill xref
  1.  ;
  1.  ; ^KMPD(8973.2,"ASSNPDTTM",KmptmpSubscript,NewPerson,ServerDateTime,DA)
  1.  ;-----------------------------------------------------------------------
  1.  Q:'$G(DA)
  1.  Q:$G(X)=""
  1.  Q:'$G(KMPDTYPE)
  1.  N NP,DATA,DATE
  1.  S DATA=$G(^KMPD(8973.2,DA,0)) Q:DATA=""
  1.  ; server start date/time
  1.  S DATE=$P(DATA,U,3) Q:'DATE
  1.  ; new person
  1.  S NP=$P(DATA,U,5) Q:NP=""
  1.  I KMPDTYPE=1 S ^KMPD(8973.2,"ASSNPDTTM",X,NP,DATE,DA)=""
  1.  I KMPDTYPE=2 K ^KMPD(8973.2,"ASSNPDTTM",X,NP,DATE,DA)
  1.  Q
  1.  ;
  1. XREFT6(DA,X,KMPDTYPE) ;-set/kill 'ASSIPDTTM' xref in file #8973.2
  1.  ;-----------------------------------------------------------------------
  1.  ; DA....... Ien for file #8973.2 (CM TIMING)
  1.  ; X........ Value of field #.07 (KMPTMP SUBSCRIPT)
  1.  ; KMPDTYPE. 1 - set xref
  1.  ;           2 - kill xref
  1.  ;
  1.  ; ^KMPD(8973.2,"ASSIPDTTM",KmptmpSubscript,IpAddress,ServerDateTime,DA)
  1.  ;-----------------------------------------------------------------------
  1.  Q:'$G(DA)
  1.  Q:$G(X)=""
  1.  Q:'$G(KMPDTYPE)
  1.  N IP,DATA,DATE
  1.  S DATA=$G(^KMPD(8973.2,DA,0)) Q:DATA=""
  1.  ; server start date/time
  1.  S DATE=$P(DATA,U,3) Q:'DATE
  1.  ; ip address
  1.  S IP=$P(DATA,U,9) Q:IP=""
  1.  I KMPDTYPE=1 S ^KMPD(8973.2,"ASSIPDTTM",X,IP,DATE,DA)=""
  1.  I KMPDTYPE=2 K ^KMPD(8973.2,"ASSIPDTTM",X,IP,DATE,DA)
  1.  Q