KMPDUT2 ;OAK/RAK - CM Tools Utility ;2/17/04 10:45
;;3.0;KMPD;;Jan 22, 2009;Build 42
;
ID(KMPDIEN) ;--called from ^DD(8973.1,0,"ID","W")
;-----------------------------------------------------------------------
; KMPDIEN... Ien for file #8973.1 (CM HL7 DATA)
;-----------------------------------------------------------------------
Q:'$G(KMPDIEN)
Q:'$D(^KMPD(8973.1,+KMPDIEN,0))
N DATA,TXT
S DATA=$G(^KMPD(8973.1,+KMPDIEN,0)),DATA(99.2)=$G(^(99.2)) Q:DATA=""
; sent to national database
S TXT(1)=$S($P(DATA,U,2):"sent",1:"not sent")
S TXT(1)=TXT(1)_$J(" ",11-$L(TXT(1)))
; namespace
S TXT(1)=TXT(1)_$P(DATA,U,3)
S TXT(1)=TXT(1)_$J(" ",18-$L(TXT(1)))
; protocol
S TXT(1)=TXT(1)_$P(DATA,U,5)
S TXT(1)=TXT(1)_$J(" ",52-$L(TXT(1)))
; synch/asynch
S TXT(1)=TXT(1)_$S($P(DATA,U,6)=1:"sync",1:"async")
; other site number
I $P(DATA(99.2),U,12)'="" D
.S TXT(2)=$P(DATA(99.2),U,12)
.S TXT(2,"F")="!?41"
S TXT(1,"F")="?15"
D EN^DDIOL(.TXT)
Q
;
ID1(KMPDIEN) ;--called from ^DD(8973.2,0,"ID","W")
;-----------------------------------------------------------------------
; KMPDIEN... Ien for file #8973.2 (CM TIMING)
;-----------------------------------------------------------------------
Q:'$G(KMPDIEN)
Q:'$D(^KMPD(8973.2,+KMPDIEN,0))
N DATA,TXT
S DATA=$G(^KMPD(8973.2,+KMPDIEN,0)) Q:DATA=""
S TXT(1)=""
; date/time
S TXT(1)=TXT(1)_$$FMTE^XLFDT($P(DATA,U,3),2)
S TXT(1)=TXT(1)_$J(" ",18-$L(TXT(1)))
; title
S TXT(1.1)=$P(DATA,U,8)
; client name
S TXT(2)="client: "_$E($P(DATA,U,6),1,30)
; person
S TXT(3)="pers : "_$P($G(^VA(200,+$P(DATA,U,5),0)),U)
; sent to national database
S TXT(4)="daily : "_$S($P(DATA,U,10):"sent",1:"not sent")
;S TXT(1)=TXT(1)_$J(" ",11-$L(TXT(1)))
S TXT(1,"F")="?45"
S TXT(1.1,"F")="!?38"
S TXT(2,"F")="!?38"
S TXT(3,"F")="!?38"
S TXT(4,"F")="!?38"
D EN^DDIOL(.TXT)
Q
;
XREF(DA,X,KMPDTYPE) ;-set/kill 'APTDTNM' xref in file #8973.1
;-----------------------------------------------------------------------
; DA....... Ien for file #8973.1 (CM HL7 DATA)
; X........ Value of field #.05 (PROTOCOL)
; KMPDTYPE. 1 - set xref
; 2 - kill xref
;-----------------------------------------------------------------------
Q:'$G(DA)
Q:$G(X)=""
Q:'$G(KMPDTYPE)
N DATA,DATE,NM
S DATA=$G(^KMPD(8973.1,DA,0)) Q:DATA=""
S DATE=$P(DATA,U) Q:'DATE
S NM=$P(DATA,U,3) Q:NM=""
I KMPDTYPE=1 S ^KMPD(8973.1,"APTDTNM",X,DATE,NM,DA)=""
I KMPDTYPE=2 K ^KMPD(8973.1,"APTDTNM",X,DATE,NM,DA)
Q
;
XREF1(DA,X,KMPDTYPE) ;-set/kill 'ACSDTPRNM' xref in file #8973.1
;-----------------------------------------------------------------------
; DA....... Ien for file #8973.1 (CM HL7 DATA)
; X........ Value of field #99.212 (CONTACTED SITE NAME)
; KMPDTYPE. 1 - set xref
; 2 - kill xref
;
; variables used:
; DATE.. Internal value of field #.01 (DATE)
; NM.... Internal value of field #.03 (NAMESPACE)
; PR.... Internal value of field #.05 (PROTOCOL)
;-----------------------------------------------------------------------
Q:'$G(DA)
Q:$G(X)=""
Q:'$G(KMPDTYPE)
N DATA,DATE,NM,PR
S DATA=$G(^KMPD(8973.1,DA,0)) Q:DATA=""
S DATE=$P(DATA,U) Q:'DATE
S NM=$P(DATA,U,3) Q:NM=""
S PR=$P(DATA,U,5) Q:PR=""
I KMPDTYPE=1 S ^KMPD(8973.1,"ACSDTPRNM",X,DATE,PR,NM,DA)=""
I KMPDTYPE=2 K ^KMPD(8973.1,"ACSDTPRNM",X,DATE,PR,NM,DA)
Q
;
XREF2(DA,X,KMPDTYPE) ;-set/kill 'ASYNC' xref in file #8973.1
;-----------------------------------------------------------------------
; DA....... Ien for file #8973.1 (CM HL7 DATA)
; X........ Value of field #.06 (SYNC/ASYNC)
; KMPDTYPE. 1 - set xref
; 2 - kill xref
;
; variables used:
; DATE.. Internal value of field #.01 (DATE)
;-----------------------------------------------------------------------
Q:'$G(DA)
Q:$G(X)=""
Q:'$G(KMPDTYPE)
N DATA,DATE
S DATA=$G(^KMPD(8973.1,DA,0)) Q:DATA=""
S DATE=$P(DATA,U) Q:'DATE
I KMPDTYPE=1 S ^KMPD(8973.1,"ASYNC",DATE,X,DA)=""
I KMPDTYPE=2 K ^KMPD(8973.1,"ASYNC",DATE,X,DA)
Q
;
XREFT1(DA,X,KMPDTYPE) ;-set/kill 'ASVDTSS' xref in file #8973.2
;-----------------------------------------------------------------------
; DA....... Ien for file #8973.2 (CM TIMING)
; X........ Value of field #.07 (SERVER SUBSCRIPT)
; KMPDTYPE. 1 - set xref
; 2 - kill xref
;-----------------------------------------------------------------------
Q:'$G(DA)
Q:$G(X)=""
Q:'$G(KMPDTYPE)
N DATA,DATE
S DATA=$G(^KMPD(8973.2,DA,0)) Q:DATA=""
; strip off time
S DATE=$P($P(DATA,U,3),".") Q:'DATE
I KMPDTYPE=1 S ^KMPD(8973.2,"ASVDTSS",X,DATE,DA)=""
I KMPDTYPE=2 K ^KMPD(8973.2,"ASVDTSS",X,DATE,DA)
Q
;
XREFT2(DA,X,KMPDTYPE) ;-set/kill 'ASSDTPT' xref in file #8973.2
;-----------------------------------------------------------------------
; DA....... Ien for file #8973.2 (CM TIMING)
; X........ Value of field #.07 (SERVER SUBSCRIPT)
; KMPDTYPE. 1 - set xref
; 2 - kill xref
;
; ^KMPD(8973.2,"ASSDTPT",ServerSubscript,ServerStartDate,PrimeTime,DA)
;-----------------------------------------------------------------------
Q:'$G(DA)
Q:$G(X)=""
Q:'$G(KMPDTYPE)
N DATA,DATE,PTNP
S DATA=$G(^KMPD(8973.2,DA,0)) Q:DATA=""
; server start date/time
S DATE=$P(DATA,U,3) Q:'DATE
; prime time / non-prime time
S PTNP=$$PTNP^KMPDHU03(DATE) Q:'PTNP
; strip off time
S DATE=$P(DATE,".") Q:'DATE
I KMPDTYPE=1 S ^KMPD(8973.2,"ASSDTPT",X,DATE,PTNP,DA)=""
I KMPDTYPE=2 K ^KMPD(8973.2,"ASSDTPT",X,DATE,PTNP,DA)
Q
;
XREFT3(DA,X,KMPDTYPE) ;-set/kill 'ASSDTTM' xref in file #8973.2
;-----------------------------------------------------------------------
; DA....... Ien for file #8973.2 (CM TIMING)
; X........ Value of field #.07 (SERVER SUBSCRIPT)
; KMPDTYPE. 1 - set xref
; 2 - kill xref
;
; ^KMPD(8973.2,"ASSDTTM",ServerSubscript,ServerStartDate,PrimeTime,DA)
;-----------------------------------------------------------------------
Q:'$G(DA)
Q:$G(X)=""
Q:'$G(KMPDTYPE)
N DATA,DATE
S DATA=$G(^KMPD(8973.2,DA,0)) Q:DATA=""
; server start date/time
S DATE=$P(DATA,U,3) Q:'DATE
I KMPDTYPE=1 S ^KMPD(8973.2,"ASSDTTM",X,DATE,DA)=""
I KMPDTYPE=2 K ^KMPD(8973.2,"ASSDTTM",X,DATE,DA)
Q
;
XREFT4(DA,X,KMPDTYPE) ;-set/kill 'ASSCLDTTM' xref in file #8973.2
;-----------------------------------------------------------------------
; DA....... Ien for file #8973.2 (CM TIMING)
; X........ Value of field #.07 (KMPTMP SUBSCRIPT)
; KMPDTYPE. 1 - set xref
; 2 - kill xref
;
; ^KMPD(8973.2,"ASSCLDTTM",KmptmpSubscript,ClientName,ServerDateTime,DA)
;-----------------------------------------------------------------------
Q:'$G(DA)
Q:$G(X)=""
Q:'$G(KMPDTYPE)
N CLNM,DATA,DATE
S DATA=$G(^KMPD(8973.2,DA,0)) Q:DATA=""
; server start date/time
S DATE=$P(DATA,U,3) Q:'DATE
; client name
S CLNM=$P(DATA,U,6) Q:CLNM=""
I KMPDTYPE=1 S ^KMPD(8973.2,"ASSCLDTTM",X,CLNM,DATE,DA)=""
I KMPDTYPE=2 K ^KMPD(8973.2,"ASSCLDTTM",X,CLNM,DATE,DA)
Q
XREFT5(DA,X,KMPDTYPE) ;-set/kill 'ASSNPDTTM' xref in file #8973.2
;-----------------------------------------------------------------------
; DA....... Ien for file #8973.2 (CM TIMING)
; X........ Value of field #.07 (KMPTMP SUBSCRIPT)
; KMPDTYPE. 1 - set xref
; 2 - kill xref
;
; ^KMPD(8973.2,"ASSNPDTTM",KmptmpSubscript,NewPerson,ServerDateTime,DA)
;-----------------------------------------------------------------------
Q:'$G(DA)
Q:$G(X)=""
Q:'$G(KMPDTYPE)
N NP,DATA,DATE
S DATA=$G(^KMPD(8973.2,DA,0)) Q:DATA=""
; server start date/time
S DATE=$P(DATA,U,3) Q:'DATE
; new person
S NP=$P(DATA,U,5) Q:NP=""
I KMPDTYPE=1 S ^KMPD(8973.2,"ASSNPDTTM",X,NP,DATE,DA)=""
I KMPDTYPE=2 K ^KMPD(8973.2,"ASSNPDTTM",X,NP,DATE,DA)
Q
;
XREFT6(DA,X,KMPDTYPE) ;-set/kill 'ASSIPDTTM' xref in file #8973.2
;-----------------------------------------------------------------------
; DA....... Ien for file #8973.2 (CM TIMING)
; X........ Value of field #.07 (KMPTMP SUBSCRIPT)
; KMPDTYPE. 1 - set xref
; 2 - kill xref
;
; ^KMPD(8973.2,"ASSIPDTTM",KmptmpSubscript,IpAddress,ServerDateTime,DA)
;-----------------------------------------------------------------------
Q:'$G(DA)
Q:$G(X)=""
Q:'$G(KMPDTYPE)
N IP,DATA,DATE
S DATA=$G(^KMPD(8973.2,DA,0)) Q:DATA=""
; server start date/time
S DATE=$P(DATA,U,3) Q:'DATE
; ip address
S IP=$P(DATA,U,9) Q:IP=""
I KMPDTYPE=1 S ^KMPD(8973.2,"ASSIPDTTM",X,IP,DATE,DA)=""
I KMPDTYPE=2 K ^KMPD(8973.2,"ASSIPDTTM",X,IP,DATE,DA)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HKMPDUT2 8618 printed Apr 09, 2024@20:45:47 Page 2
KMPDUT2 ;OAK/RAK - CM Tools Utility ;2/17/04 10:45
+1 ;;3.0;KMPD;;Jan 22, 2009;Build 42
+2 ;
ID(KMPDIEN) ;--called from ^DD(8973.1,0,"ID","W")
+1 ;-----------------------------------------------------------------------
+2 ; KMPDIEN... Ien for file #8973.1 (CM HL7 DATA)
+3 ;-----------------------------------------------------------------------
+4 if '$GET(KMPDIEN)
QUIT
+5 if '$DATA(^KMPD(8973.1,+KMPDIEN,0))
QUIT
+6 NEW DATA,TXT
+7 SET DATA=$GET(^KMPD(8973.1,+KMPDIEN,0))
SET DATA(99.2)=$GET(^(99.2))
if DATA=""
QUIT
+8 ; sent to national database
+9 SET TXT(1)=$SELECT($PIECE(DATA,U,2):"sent",1:"not sent")
+10 SET TXT(1)=TXT(1)_$JUSTIFY(" ",11-$LENGTH(TXT(1)))
+11 ; namespace
+12 SET TXT(1)=TXT(1)_$PIECE(DATA,U,3)
+13 SET TXT(1)=TXT(1)_$JUSTIFY(" ",18-$LENGTH(TXT(1)))
+14 ; protocol
+15 SET TXT(1)=TXT(1)_$PIECE(DATA,U,5)
+16 SET TXT(1)=TXT(1)_$JUSTIFY(" ",52-$LENGTH(TXT(1)))
+17 ; synch/asynch
+18 SET TXT(1)=TXT(1)_$SELECT($PIECE(DATA,U,6)=1:"sync",1:"async")
+19 ; other site number
+20 IF $PIECE(DATA(99.2),U,12)'=""
Begin DoDot:1
+21 SET TXT(2)=$PIECE(DATA(99.2),U,12)
+22 SET TXT(2,"F")="!?41"
End DoDot:1
+23 SET TXT(1,"F")="?15"
+24 DO EN^DDIOL(.TXT)
+25 QUIT
+26 ;
ID1(KMPDIEN) ;--called from ^DD(8973.2,0,"ID","W")
+1 ;-----------------------------------------------------------------------
+2 ; KMPDIEN... Ien for file #8973.2 (CM TIMING)
+3 ;-----------------------------------------------------------------------
+4 if '$GET(KMPDIEN)
QUIT
+5 if '$DATA(^KMPD(8973.2,+KMPDIEN,0))
QUIT
+6 NEW DATA,TXT
+7 SET DATA=$GET(^KMPD(8973.2,+KMPDIEN,0))
if DATA=""
QUIT
+8 SET TXT(1)=""
+9 ; date/time
+10 SET TXT(1)=TXT(1)_$$FMTE^XLFDT($PIECE(DATA,U,3),2)
+11 SET TXT(1)=TXT(1)_$JUSTIFY(" ",18-$LENGTH(TXT(1)))
+12 ; title
+13 SET TXT(1.1)=$PIECE(DATA,U,8)
+14 ; client name
+15 SET TXT(2)="client: "_$EXTRACT($PIECE(DATA,U,6),1,30)
+16 ; person
+17 SET TXT(3)="pers : "_$PIECE($GET(^VA(200,+$PIECE(DATA,U,5),0)),U)
+18 ; sent to national database
+19 SET TXT(4)="daily : "_$SELECT($PIECE(DATA,U,10):"sent",1:"not sent")
+20 ;S TXT(1)=TXT(1)_$J(" ",11-$L(TXT(1)))
+21 SET TXT(1,"F")="?45"
+22 SET TXT(1.1,"F")="!?38"
+23 SET TXT(2,"F")="!?38"
+24 SET TXT(3,"F")="!?38"
+25 SET TXT(4,"F")="!?38"
+26 DO EN^DDIOL(.TXT)
+27 QUIT
+28 ;
XREF(DA,X,KMPDTYPE) ;-set/kill 'APTDTNM' xref in file #8973.1
+1 ;-----------------------------------------------------------------------
+2 ; DA....... Ien for file #8973.1 (CM HL7 DATA)
+3 ; X........ Value of field #.05 (PROTOCOL)
+4 ; KMPDTYPE. 1 - set xref
+5 ; 2 - kill xref
+6 ;-----------------------------------------------------------------------
+7 if '$GET(DA)
QUIT
+8 if $GET(X)=""
QUIT
+9 if '$GET(KMPDTYPE)
QUIT
+10 NEW DATA,DATE,NM
+11 SET DATA=$GET(^KMPD(8973.1,DA,0))
if DATA=""
QUIT
+12 SET DATE=$PIECE(DATA,U)
if 'DATE
QUIT
+13 SET NM=$PIECE(DATA,U,3)
if NM=""
QUIT
+14 IF KMPDTYPE=1
SET ^KMPD(8973.1,"APTDTNM",X,DATE,NM,DA)=""
+15 IF KMPDTYPE=2
KILL ^KMPD(8973.1,"APTDTNM",X,DATE,NM,DA)
+16 QUIT
+17 ;
XREF1(DA,X,KMPDTYPE) ;-set/kill 'ACSDTPRNM' xref in file #8973.1
+1 ;-----------------------------------------------------------------------
+2 ; DA....... Ien for file #8973.1 (CM HL7 DATA)
+3 ; X........ Value of field #99.212 (CONTACTED SITE NAME)
+4 ; KMPDTYPE. 1 - set xref
+5 ; 2 - kill xref
+6 ;
+7 ; variables used:
+8 ; DATE.. Internal value of field #.01 (DATE)
+9 ; NM.... Internal value of field #.03 (NAMESPACE)
+10 ; PR.... Internal value of field #.05 (PROTOCOL)
+11 ;-----------------------------------------------------------------------
+12 if '$GET(DA)
QUIT
+13 if $GET(X)=""
QUIT
+14 if '$GET(KMPDTYPE)
QUIT
+15 NEW DATA,DATE,NM,PR
+16 SET DATA=$GET(^KMPD(8973.1,DA,0))
if DATA=""
QUIT
+17 SET DATE=$PIECE(DATA,U)
if 'DATE
QUIT
+18 SET NM=$PIECE(DATA,U,3)
if NM=""
QUIT
+19 SET PR=$PIECE(DATA,U,5)
if PR=""
QUIT
+20 IF KMPDTYPE=1
SET ^KMPD(8973.1,"ACSDTPRNM",X,DATE,PR,NM,DA)=""
+21 IF KMPDTYPE=2
KILL ^KMPD(8973.1,"ACSDTPRNM",X,DATE,PR,NM,DA)
+22 QUIT
+23 ;
XREF2(DA,X,KMPDTYPE) ;-set/kill 'ASYNC' xref in file #8973.1
+1 ;-----------------------------------------------------------------------
+2 ; DA....... Ien for file #8973.1 (CM HL7 DATA)
+3 ; X........ Value of field #.06 (SYNC/ASYNC)
+4 ; KMPDTYPE. 1 - set xref
+5 ; 2 - kill xref
+6 ;
+7 ; variables used:
+8 ; DATE.. Internal value of field #.01 (DATE)
+9 ;-----------------------------------------------------------------------
+10 if '$GET(DA)
QUIT
+11 if $GET(X)=""
QUIT
+12 if '$GET(KMPDTYPE)
QUIT
+13 NEW DATA,DATE
+14 SET DATA=$GET(^KMPD(8973.1,DA,0))
if DATA=""
QUIT
+15 SET DATE=$PIECE(DATA,U)
if 'DATE
QUIT
+16 IF KMPDTYPE=1
SET ^KMPD(8973.1,"ASYNC",DATE,X,DA)=""
+17 IF KMPDTYPE=2
KILL ^KMPD(8973.1,"ASYNC",DATE,X,DA)
+18 QUIT
+19 ;
XREFT1(DA,X,KMPDTYPE) ;-set/kill 'ASVDTSS' xref in file #8973.2
+1 ;-----------------------------------------------------------------------
+2 ; DA....... Ien for file #8973.2 (CM TIMING)
+3 ; X........ Value of field #.07 (SERVER SUBSCRIPT)
+4 ; KMPDTYPE. 1 - set xref
+5 ; 2 - kill xref
+6 ;-----------------------------------------------------------------------
+7 if '$GET(DA)
QUIT
+8 if $GET(X)=""
QUIT
+9 if '$GET(KMPDTYPE)
QUIT
+10 NEW DATA,DATE
+11 SET DATA=$GET(^KMPD(8973.2,DA,0))
if DATA=""
QUIT
+12 ; strip off time
+13 SET DATE=$PIECE($PIECE(DATA,U,3),".")
if 'DATE
QUIT
+14 IF KMPDTYPE=1
SET ^KMPD(8973.2,"ASVDTSS",X,DATE,DA)=""
+15 IF KMPDTYPE=2
KILL ^KMPD(8973.2,"ASVDTSS",X,DATE,DA)
+16 QUIT
+17 ;
XREFT2(DA,X,KMPDTYPE) ;-set/kill 'ASSDTPT' xref in file #8973.2
+1 ;-----------------------------------------------------------------------
+2 ; DA....... Ien for file #8973.2 (CM TIMING)
+3 ; X........ Value of field #.07 (SERVER SUBSCRIPT)
+4 ; KMPDTYPE. 1 - set xref
+5 ; 2 - kill xref
+6 ;
+7 ; ^KMPD(8973.2,"ASSDTPT",ServerSubscript,ServerStartDate,PrimeTime,DA)
+8 ;-----------------------------------------------------------------------
+9 if '$GET(DA)
QUIT
+10 if $GET(X)=""
QUIT
+11 if '$GET(KMPDTYPE)
QUIT
+12 NEW DATA,DATE,PTNP
+13 SET DATA=$GET(^KMPD(8973.2,DA,0))
if DATA=""
QUIT
+14 ; server start date/time
+15 SET DATE=$PIECE(DATA,U,3)
if 'DATE
QUIT
+16 ; prime time / non-prime time
+17 SET PTNP=$$PTNP^KMPDHU03(DATE)
if 'PTNP
QUIT
+18 ; strip off time
+19 SET DATE=$PIECE(DATE,".")
if 'DATE
QUIT
+20 IF KMPDTYPE=1
SET ^KMPD(8973.2,"ASSDTPT",X,DATE,PTNP,DA)=""
+21 IF KMPDTYPE=2
KILL ^KMPD(8973.2,"ASSDTPT",X,DATE,PTNP,DA)
+22 QUIT
+23 ;
XREFT3(DA,X,KMPDTYPE) ;-set/kill 'ASSDTTM' xref in file #8973.2
+1 ;-----------------------------------------------------------------------
+2 ; DA....... Ien for file #8973.2 (CM TIMING)
+3 ; X........ Value of field #.07 (SERVER SUBSCRIPT)
+4 ; KMPDTYPE. 1 - set xref
+5 ; 2 - kill xref
+6 ;
+7 ; ^KMPD(8973.2,"ASSDTTM",ServerSubscript,ServerStartDate,PrimeTime,DA)
+8 ;-----------------------------------------------------------------------
+9 if '$GET(DA)
QUIT
+10 if $GET(X)=""
QUIT
+11 if '$GET(KMPDTYPE)
QUIT
+12 NEW DATA,DATE
+13 SET DATA=$GET(^KMPD(8973.2,DA,0))
if DATA=""
QUIT
+14 ; server start date/time
+15 SET DATE=$PIECE(DATA,U,3)
if 'DATE
QUIT
+16 IF KMPDTYPE=1
SET ^KMPD(8973.2,"ASSDTTM",X,DATE,DA)=""
+17 IF KMPDTYPE=2
KILL ^KMPD(8973.2,"ASSDTTM",X,DATE,DA)
+18 QUIT
+19 ;
XREFT4(DA,X,KMPDTYPE) ;-set/kill 'ASSCLDTTM' xref in file #8973.2
+1 ;-----------------------------------------------------------------------
+2 ; DA....... Ien for file #8973.2 (CM TIMING)
+3 ; X........ Value of field #.07 (KMPTMP SUBSCRIPT)
+4 ; KMPDTYPE. 1 - set xref
+5 ; 2 - kill xref
+6 ;
+7 ; ^KMPD(8973.2,"ASSCLDTTM",KmptmpSubscript,ClientName,ServerDateTime,DA)
+8 ;-----------------------------------------------------------------------
+9 if '$GET(DA)
QUIT
+10 if $GET(X)=""
QUIT
+11 if '$GET(KMPDTYPE)
QUIT
+12 NEW CLNM,DATA,DATE
+13 SET DATA=$GET(^KMPD(8973.2,DA,0))
if DATA=""
QUIT
+14 ; server start date/time
+15 SET DATE=$PIECE(DATA,U,3)
if 'DATE
QUIT
+16 ; client name
+17 SET CLNM=$PIECE(DATA,U,6)
if CLNM=""
QUIT
+18 IF KMPDTYPE=1
SET ^KMPD(8973.2,"ASSCLDTTM",X,CLNM,DATE,DA)=""
+19 IF KMPDTYPE=2
KILL ^KMPD(8973.2,"ASSCLDTTM",X,CLNM,DATE,DA)
+20 QUIT
XREFT5(DA,X,KMPDTYPE) ;-set/kill 'ASSNPDTTM' xref in file #8973.2
+1 ;-----------------------------------------------------------------------
+2 ; DA....... Ien for file #8973.2 (CM TIMING)
+3 ; X........ Value of field #.07 (KMPTMP SUBSCRIPT)
+4 ; KMPDTYPE. 1 - set xref
+5 ; 2 - kill xref
+6 ;
+7 ; ^KMPD(8973.2,"ASSNPDTTM",KmptmpSubscript,NewPerson,ServerDateTime,DA)
+8 ;-----------------------------------------------------------------------
+9 if '$GET(DA)
QUIT
+10 if $GET(X)=""
QUIT
+11 if '$GET(KMPDTYPE)
QUIT
+12 NEW NP,DATA,DATE
+13 SET DATA=$GET(^KMPD(8973.2,DA,0))
if DATA=""
QUIT
+14 ; server start date/time
+15 SET DATE=$PIECE(DATA,U,3)
if 'DATE
QUIT
+16 ; new person
+17 SET NP=$PIECE(DATA,U,5)
if NP=""
QUIT
+18 IF KMPDTYPE=1
SET ^KMPD(8973.2,"ASSNPDTTM",X,NP,DATE,DA)=""
+19 IF KMPDTYPE=2
KILL ^KMPD(8973.2,"ASSNPDTTM",X,NP,DATE,DA)
+20 QUIT
+21 ;
XREFT6(DA,X,KMPDTYPE) ;-set/kill 'ASSIPDTTM' xref in file #8973.2
+1 ;-----------------------------------------------------------------------
+2 ; DA....... Ien for file #8973.2 (CM TIMING)
+3 ; X........ Value of field #.07 (KMPTMP SUBSCRIPT)
+4 ; KMPDTYPE. 1 - set xref
+5 ; 2 - kill xref
+6 ;
+7 ; ^KMPD(8973.2,"ASSIPDTTM",KmptmpSubscript,IpAddress,ServerDateTime,DA)
+8 ;-----------------------------------------------------------------------
+9 if '$GET(DA)
QUIT
+10 if $GET(X)=""
QUIT
+11 if '$GET(KMPDTYPE)
QUIT
+12 NEW IP,DATA,DATE
+13 SET DATA=$GET(^KMPD(8973.2,DA,0))
if DATA=""
QUIT
+14 ; server start date/time
+15 SET DATE=$PIECE(DATA,U,3)
if 'DATE
QUIT
+16 ; ip address
+17 SET IP=$PIECE(DATA,U,9)
if IP=""
QUIT
+18 IF KMPDTYPE=1
SET ^KMPD(8973.2,"ASSIPDTTM",X,IP,DATE,DA)=""
+19 IF KMPDTYPE=2
KILL ^KMPD(8973.2,"ASSIPDTTM",X,IP,DATE,DA)
+20 QUIT
