TIUOTPF ;BIR/CGN - OTP load HL7 dispense data into file #101.22 ; Oct 2, 2024@09:39:00
;;1.0;TEXT INTEGRATION UTILITIES;**360**;Jun 20, 1997;Build 14
;
; Reference to ^DPT in ICR# 10035
; Reference to ^HL(771 in ICR# 10136
; Reference to ^HL(772 in ICR# 4069
; Reference to ^ORD(101 in ICR# 872
;
; Reference to %DT in ICR# 10003
; Reference to UPDATE^DIE in ICR# 2053
; Reference to $$FIND1^DIC in ICR# 2051
; Reference to $$GET1^DIQ in ICR# 2056
; Reference to ^XLFDT in ICR# 10103
; Reference to EN^ORDOTP1 in ICR# 7500
;
PARSE(PTR) ;
; Extract HL7 dispense data and prepare to load those values into file #101.22
; Called from a protocol (EXIT ACTION)
N COUNT,DATA,DFN,DTE,EVENT,F,FLD,I,INIT,L,NAME,P,SENDER,SETARRAY,SN,SQ,STR,TMP,VAL,X,XTMP,Y
;GET DATA
I $$GET1^DIQ(772,PTR_",",.01)="" Q ;No Data Found
M TMP=^HL(772,PTR,"IN")
S DATA=$P($G(^HL(772,PTR,0)),"^",10),SENDER=$P($G(^ORD(101,DATA,770)),"^",1)
I SENDER'="" S SENDER=$P($G(^HL(771,SENDER,0)),"^",1)
I SENDER="" S SENDER="OTP INTERFACE"
S DTE=$P($G(^HL(772,PTR,0)),"^",1),COUNT="",SETARRAY=1,SQ=0
F S SQ=$O(TMP(SQ)) Q:SQ="" D
. S DATA=TMP(SQ,0)
. I DATA="" S SETARRAY=1 Q
. I DATA'="" D
. . I $P(DATA,"|",1)="EVN" S EVENT=$P(DATA,"|",2)
. . I SETARRAY S COUNT=COUNT+1,XTMP(COUNT)=DATA,SETARRAY=0
. . E S XTMP(COUNT)=XTMP(COUNT)_DATA
S STR="" K %DT
I $G(EVENT)="" Q
I $G(EVENT)="T02" D
. S FLD(.01)="Medication Date = ",FLD(2)="Medication Type = ",FLD(3)="Dispense Date = ",FLD(3.3)="Dispense Time = "
. S FLD(4)="Dispensed By = ",FLD(6)="Pickup Type = ",FLD(7)="Dispense Amount = "
. S SQ="" F S SQ=$O(XTMP(SQ)) Q:SQ="" D
. . S DATA=XTMP(SQ) D
. . . I $P(DATA,"|",1)="PID" S SN=$P($P(DATA,"|",4),"^",1),DFN=$$FIND1^DIC(2,"","X",SN,"SSN")
. . . I $P(DATA,"|",1)="OBX" D
. . . . F I=2,3,4,6,7 S P=FLD(I) S VAL=$P(DATA,P,2),VAL=$P(VAL,"~",1),VAL=$P(VAL,"|",1),$P(STR,"^",I)=VAL
. . . . S VAL=$P(DATA,FLD(3.3),2),VAL=$P(VAL,"~",1),VAL=$P(VAL,":",1,2),X=$P(STR,"^",3)_"@"_VAL,%DT="T" D ^%DT S $P(STR,"^",3)=Y
. . . . S VAL=$P(DATA,FLD(.01),2),VAL=$P(VAL,"~",1),X=VAL D ^%DT S $P(STR,"^",1)=Y
I $G(EVENT)="P03" D
. S SQ="" F S SQ=$O(XTMP(SQ)) Q:SQ="" D
. . S DATA=XTMP(SQ) D
. . . I $P(DATA,"|",1)="PID" S SN=$P(DATA,"|",20),DFN=$$FIND1^DIC(2,"","X",SN,"SSN")
. . . I $P(DATA,"|",1)="FT1" D
. . . . S $P(STR,"^",3)=$$HL7TFM^XLFDT($P(DATA,"|",5))
. . . . S $P(STR,"^",1)=$P(DATA,"|",6)
. . . . S $P(STR,"^",6)=$P(DATA,"|",7)
. . . . S $P(STR,"^",7)=$P($P(DATA,"|",13),"^",5)
. . . . S NAME=$P(DATA,"|",21),$P(STR,"^",4)=$P(NAME,"^",3)_","_$P(NAME,"^",2)
. . . . S $P(STR,"^",2)=$P($P(DATA,"|",26),"^",2)
S $P(STR,"^",6)=$S($P(STR,"^",6)["Clinic":"C",$P(STR,"^",6)["Take":"H",1:$P(STR,"^",6))
S $P(STR,"^",8)=$S($G(DTE)="":DTE,1:$$NOW^XLFDT)
S $P(STR,"^",9)=SENDER
S NAME=$P(STR,"^",4),INIT=""
I NAME["," S F=$P(NAME,",",2),L=$P(NAME,",",1),INIT=$E(F)_$E(L)
E S F=$E(NAME),L=$P(NAME," ",2),L=$E(L,1),INIT=F_L
S $P(STR,"^",5)=INIT
D EN^ORDOTP1(DFN,STR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUOTPF 3046 printed Aug 26, 2025@22:58:42 Page 2
TIUOTPF ;BIR/CGN - OTP load HL7 dispense data into file #101.22 ; Oct 2, 2024@09:39:00
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**360**;Jun 20, 1997;Build 14
+2 ;
+3 ; Reference to ^DPT in ICR# 10035
+4 ; Reference to ^HL(771 in ICR# 10136
+5 ; Reference to ^HL(772 in ICR# 4069
+6 ; Reference to ^ORD(101 in ICR# 872
+7 ;
+8 ; Reference to %DT in ICR# 10003
+9 ; Reference to UPDATE^DIE in ICR# 2053
+10 ; Reference to $$FIND1^DIC in ICR# 2051
+11 ; Reference to $$GET1^DIQ in ICR# 2056
+12 ; Reference to ^XLFDT in ICR# 10103
+13 ; Reference to EN^ORDOTP1 in ICR# 7500
+14 ;
PARSE(PTR) ;
+1 ; Extract HL7 dispense data and prepare to load those values into file #101.22
+2 ; Called from a protocol (EXIT ACTION)
+3 NEW COUNT,DATA,DFN,DTE,EVENT,F,FLD,I,INIT,L,NAME,P,SENDER,SETARRAY,SN,SQ,STR,TMP,VAL,X,XTMP,Y
+4 ;GET DATA
+5 ;No Data Found
IF $$GET1^DIQ(772,PTR_",",.01)=""
QUIT
+6 MERGE TMP=^HL(772,PTR,"IN")
+7 SET DATA=$PIECE($GET(^HL(772,PTR,0)),"^",10)
SET SENDER=$PIECE($GET(^ORD(101,DATA,770)),"^",1)
+8 IF SENDER'=""
SET SENDER=$PIECE($GET(^HL(771,SENDER,0)),"^",1)
+9 IF SENDER=""
SET SENDER="OTP INTERFACE"
+10 SET DTE=$PIECE($GET(^HL(772,PTR,0)),"^",1)
SET COUNT=""
SET SETARRAY=1
SET SQ=0
+11 FOR
SET SQ=$ORDER(TMP(SQ))
if SQ=""
QUIT
Begin DoDot:1
+12 SET DATA=TMP(SQ,0)
+13 IF DATA=""
SET SETARRAY=1
QUIT
+14 IF DATA'=""
Begin DoDot:2
+15 IF $PIECE(DATA,"|",1)="EVN"
SET EVENT=$PIECE(DATA,"|",2)
+16 IF SETARRAY
SET COUNT=COUNT+1
SET XTMP(COUNT)=DATA
SET SETARRAY=0
+17 IF '$TEST
SET XTMP(COUNT)=XTMP(COUNT)_DATA
End DoDot:2
End DoDot:1
+18 SET STR=""
KILL %DT
+19 IF $GET(EVENT)=""
QUIT
+20 IF $GET(EVENT)="T02"
Begin DoDot:1
+21 SET FLD(.01)="Medication Date = "
SET FLD(2)="Medication Type = "
SET FLD(3)="Dispense Date = "
SET FLD(3.3)="Dispense Time = "
+22 SET FLD(4)="Dispensed By = "
SET FLD(6)="Pickup Type = "
SET FLD(7)="Dispense Amount = "
+23 SET SQ=""
FOR
SET SQ=$ORDER(XTMP(SQ))
if SQ=""
QUIT
Begin DoDot:2
+24 SET DATA=XTMP(SQ)
Begin DoDot:3
+25 IF $PIECE(DATA,"|",1)="PID"
SET SN=$PIECE($PIECE(DATA,"|",4),"^",1)
SET DFN=$$FIND1^DIC(2,"","X",SN,"SSN")
+26 IF $PIECE(DATA,"|",1)="OBX"
Begin DoDot:4
+27 FOR I=2,3,4,6,7
SET P=FLD(I)
SET VAL=$PIECE(DATA,P,2)
SET VAL=$PIECE(VAL,"~",1)
SET VAL=$PIECE(VAL,"|",1)
SET $PIECE(STR,"^",I)=VAL
+28 SET VAL=$PIECE(DATA,FLD(3.3),2)
SET VAL=$PIECE(VAL,"~",1)
SET VAL=$PIECE(VAL,":",1,2)
SET X=$PIECE(STR,"^",3)_"@"_VAL
SET %DT="T"
DO ^%DT
SET $PIECE(STR,"^",3)=Y
+29 SET VAL=$PIECE(DATA,FLD(.01),2)
SET VAL=$PIECE(VAL,"~",1)
SET X=VAL
DO ^%DT
SET $PIECE(STR,"^",1)=Y
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+30 IF $GET(EVENT)="P03"
Begin DoDot:1
+31 SET SQ=""
FOR
SET SQ=$ORDER(XTMP(SQ))
if SQ=""
QUIT
Begin DoDot:2
+32 SET DATA=XTMP(SQ)
Begin DoDot:3
+33 IF $PIECE(DATA,"|",1)="PID"
SET SN=$PIECE(DATA,"|",20)
SET DFN=$$FIND1^DIC(2,"","X",SN,"SSN")
+34 IF $PIECE(DATA,"|",1)="FT1"
Begin DoDot:4
+35 SET $PIECE(STR,"^",3)=$$HL7TFM^XLFDT($PIECE(DATA,"|",5))
+36 SET $PIECE(STR,"^",1)=$PIECE(DATA,"|",6)
+37 SET $PIECE(STR,"^",6)=$PIECE(DATA,"|",7)
+38 SET $PIECE(STR,"^",7)=$PIECE($PIECE(DATA,"|",13),"^",5)
+39 SET NAME=$PIECE(DATA,"|",21)
SET $PIECE(STR,"^",4)=$PIECE(NAME,"^",3)_","_$PIECE(NAME,"^",2)
+40 SET $PIECE(STR,"^",2)=$PIECE($PIECE(DATA,"|",26),"^",2)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+41 SET $PIECE(STR,"^",6)=$SELECT($PIECE(STR,"^",6)["Clinic":"C",$PIECE(STR,"^",6)["Take":"H",1:$PIECE(STR,"^",6))
+42 SET $PIECE(STR,"^",8)=$SELECT($GET(DTE)="":DTE,1:$$NOW^XLFDT)
+43 SET $PIECE(STR,"^",9)=SENDER
+44 SET NAME=$PIECE(STR,"^",4)
SET INIT=""
+45 IF NAME[","
SET F=$PIECE(NAME,",",2)
SET L=$PIECE(NAME,",",1)
SET INIT=$EXTRACT(F)_$EXTRACT(L)
+46 IF '$TEST
SET F=$EXTRACT(NAME)
SET L=$PIECE(NAME," ",2)
SET L=$EXTRACT(L,1)
SET INIT=F_L
+47 SET $PIECE(STR,"^",5)=INIT
+48 DO EN^ORDOTP1(DFN,STR)
+49 QUIT
