MDHL7U ; HOIFO/WAA -Routine utilities for CP ;7/23/01 11:41
;;1.0;CLINICAL PROCEDURES;;Apr 01, 2004
;
UPDATE(MDIEN) ; Update File
N DZ
S DZ=0
UPD1 L +^MDD(703.1,MDIEN,.1,0):1 G:'$T UPD1
S DZ=$P(^MDD(703.1,MDIEN,.1,0),"^",3)+1
S $P(^MDD(703.1,MDIEN,.1,0),"^",3,4)=DZ_"^"_DZ
L -^MDD(703.1,MDIEN,.1,0)
Q DZ
;
ATT(DEV,ARRAY) ; Get the attributes of a device and pass them back in an
; array.
N X
S ARRAY=0
I $G(^MDS(702.09,DEV,0))="" D
. S X=0
. S X=$O(^MDS(702.09,"B",DEV,X))
. Q
E S X=DEV
I X>0 D
. N LINE,I,Z
. S LINE=$G(^MDS(702.09,X,.3)) Q:LINE=""
. S Z=""
. F I=1:1:($L(LINE,U)) S Z=$P(LINE,U,I) I Z=1 D
. . N TEXT
. . S TEXT=$T(ATABLE+I)
. . S ARRAY(I)=TEXT,ARRAY=ARRAY+1
. . Q
. Q
Q
PROC ; Create report entry in file (703.1)
N DA,DIK
I DTO=""!(DFN="") Q
S DA=0 F S DA=$O(^MDD(703.1,"B",UNIQ,DA)) Q:'DA I $P($G(^MDD(703.1,DA,0)),"^",5)=DFN Q
Q:DA
P1 L +^MDD(703.1,0):0 G:'$T P1 D
.S DA=$P(^MDD(703.1,0),"^",3)+1
.S $P(^MDD(703.1,0),"^",3,4)=DA_"^"_DA
.L -^MDD(703.1,0)
.Q
I $D(^MDD(703.1,DA)) G P1
S ^MDD(703.1,DA,0)=UNIQ_"^"_DFN_"^"_$$HL7TFM(DATE)_"^"_INST_"^"_$G(MDD702)_"^"_HLMTIEN_"^^^P"
S ^MDD(703.1,DA,.1,0)="^703.11S^0^0"
S MDIEN=DA
S DIK="^MDD(703.1," D IX1^DIK
Q
;
HL7TFM(MDDATE) ; Convert an HL7 Date to FM
N MDDT,MDYR
S MDYR=$E(MDDATE,1,4)
S MDYR=MDYR-1700
S MDDT=MDYR_$E(MDDATE,5,8)
I $L(MDDATE)>8 S MDDT=MDDT_"."_$E(MDDATE,9,14)
Q MDDT
REINDX ; Re-index record
S ^MDD(703.1,DA,.1,DZ,.2,0)="^^"_LN_"^"_LN_"^"_DTO
S DIK="^MDD(703.1," D IX1^DIK
D:ZCODE="C" GENACK^MDHL7X
Q
ATABLE ;;This is a table of all the processing routines for devices
;;PROCESS UNC;.301;UNC^MDHL7U1;3;
;;PROCESS TEXT;.302;TEXT^MDHL7U2;2;
;;PROCESS URL;.303;URL^MDHL7U1;4;
;;PROCESS DLL;.304;DDL^MDHL7U1;6;
;;PROCESS UUENCODE;.305;UUEN^MDHL7U1;5;
;;PROCESS XML;.306;XML^MDHL7U1;7;
;;PROCESS XMS;.307;XMS^MDHL7U1;8;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDHL7U 1934 printed Apr 09, 2024@20:48:15 Page 2
MDHL7U ; HOIFO/WAA -Routine utilities for CP ;7/23/01 11:41
+1 ;;1.0;CLINICAL PROCEDURES;;Apr 01, 2004
+2 ;
UPDATE(MDIEN) ; Update File
+1 NEW DZ
+2 SET DZ=0
UPD1 LOCK +^MDD(703.1,MDIEN,.1,0):1
if '$TEST
GOTO UPD1
+1 SET DZ=$PIECE(^MDD(703.1,MDIEN,.1,0),"^",3)+1
+2 SET $PIECE(^MDD(703.1,MDIEN,.1,0),"^",3,4)=DZ_"^"_DZ
+3 LOCK -^MDD(703.1,MDIEN,.1,0)
+4 QUIT DZ
+5 ;
ATT(DEV,ARRAY) ; Get the attributes of a device and pass them back in an
+1 ; array.
+2 NEW X
+3 SET ARRAY=0
+4 IF $GET(^MDS(702.09,DEV,0))=""
Begin DoDot:1
+5 SET X=0
+6 SET X=$ORDER(^MDS(702.09,"B",DEV,X))
+7 QUIT
End DoDot:1
+8 IF '$TEST
SET X=DEV
+9 IF X>0
Begin DoDot:1
+10 NEW LINE,I,Z
+11 SET LINE=$GET(^MDS(702.09,X,.3))
if LINE=""
QUIT
+12 SET Z=""
+13 FOR I=1:1:($LENGTH(LINE,U))
SET Z=$PIECE(LINE,U,I)
IF Z=1
Begin DoDot:2
+14 NEW TEXT
+15 SET TEXT=$TEXT(ATABLE+I)
+16 SET ARRAY(I)=TEXT
SET ARRAY=ARRAY+1
+17 QUIT
End DoDot:2
+18 QUIT
End DoDot:1
+19 QUIT
PROC ; Create report entry in file (703.1)
+1 NEW DA,DIK
+2 IF DTO=""!(DFN="")
QUIT
+3 SET DA=0
FOR
SET DA=$ORDER(^MDD(703.1,"B",UNIQ,DA))
if 'DA
QUIT
IF $PIECE($GET(^MDD(703.1,DA,0)),"^",5)=DFN
QUIT
+4 if DA
QUIT
P1 LOCK +^MDD(703.1,0):0
if '$TEST
GOTO P1
Begin DoDot:1
+1 SET DA=$PIECE(^MDD(703.1,0),"^",3)+1
+2 SET $PIECE(^MDD(703.1,0),"^",3,4)=DA_"^"_DA
+3 LOCK -^MDD(703.1,0)
+4 QUIT
End DoDot:1
+5 IF $DATA(^MDD(703.1,DA))
GOTO P1
+6 SET ^MDD(703.1,DA,0)=UNIQ_"^"_DFN_"^"_$$HL7TFM(DATE)_"^"_INST_"^"_$GET(MDD702)_"^"_HLMTIEN_"^^^P"
+7 SET ^MDD(703.1,DA,.1,0)="^703.11S^0^0"
+8 SET MDIEN=DA
+9 SET DIK="^MDD(703.1,"
DO IX1^DIK
+10 QUIT
+11 ;
HL7TFM(MDDATE) ; Convert an HL7 Date to FM
+1 NEW MDDT,MDYR
+2 SET MDYR=$EXTRACT(MDDATE,1,4)
+3 SET MDYR=MDYR-1700
+4 SET MDDT=MDYR_$EXTRACT(MDDATE,5,8)
+5 IF $LENGTH(MDDATE)>8
SET MDDT=MDDT_"."_$EXTRACT(MDDATE,9,14)
+6 QUIT MDDT
REINDX ; Re-index record
+1 SET ^MDD(703.1,DA,.1,DZ,.2,0)="^^"_LN_"^"_LN_"^"_DTO
+2 SET DIK="^MDD(703.1,"
DO IX1^DIK
+3 if ZCODE="C"
DO GENACK^MDHL7X
+4 QUIT
ATABLE ;;This is a table of all the processing routines for devices
+1 ;;PROCESS UNC;.301;UNC^MDHL7U1;3;
+2 ;;PROCESS TEXT;.302;TEXT^MDHL7U2;2;
+3 ;;PROCESS URL;.303;URL^MDHL7U1;4;
+4 ;;PROCESS DLL;.304;DDL^MDHL7U1;6;
+5 ;;PROCESS UUENCODE;.305;UUEN^MDHL7U1;5;
+6 ;;PROCESS XML;.306;XML^MDHL7U1;7;
+7 ;;PROCESS XMS;.307;XMS^MDHL7U1;8;
