DGV53PTE.m

DGV53PTE ;AISC/SAW-Convert EDR data from file 705 to file 391.51 ;7/16/93  16:07

 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 ;;

 W !!,">>> Converting EDR data from file #705 to file #391.51..."

 S %X="^EDR(705,",%Y="^VAT(391.51," D %XY^%RCR S $P(^VAT(391.51,0),"^",1,2)="PIMS EDR EVENT^391.51D" K %X,%Y

 S DIU="^EDR(705,",DIU(0)="DST" D EN^DIU2 K DIU

 S DA(1)=+$O(^ORD(101,"B","DGPM MOVEMENT EVENTS",0)),VAFEDX=+$O(^ORD(101,"B","EDR CAPTURE EVENTS",0)),DA=+$O(^ORD(101,"AD",VAFEDX,DA(1),0))

 I DA(1),DA S DIK="^ORD(101,"_DA(1)_",10," D ^DIK

 I VAFEDX S DA=VAFEDX,DIK="^ORD(101," D ^DIK

 ;I '$D(^HL(770,0)) W !!,*7,"You have not yet initialized the DHCP HL7 package.  Be sure to re-run this part",!,"of the post-init (D ^DGV53PTE) after you initialize the DHCP HL7 package." G EXIT

771 S VAFEDDA=$O(^HL(771,"B","EDR-MAS",0)) I 'VAFEDDA K DD,DO S X="EDR-MAS",DIC="^HL(771,",DIC(0)="" D FILE^DICN G 771:Y<0 S (DA,VAFEDDA)=+Y,DIE=DIC,DR="2///I" D ^DIE

770 S DA=$O(^HL(770,"B","EDR-MAS",0)) I 'DA K DA,DD,DO,DR S X="EDR-MAS",DIC="^HL(770,",DIC(0)="" D FILE^DICN G 770:Y<0 S DA=+Y,DIE=DIC,DR="3///RCP;4///245;7///2.1;8////"_VAFEDDA_";14///P" D ^DIE

 S X=$O(^XMB(3.8,"B","EDR-RCP",0)) I X S $P(^HL(770,DA,0),"^",10)=X

EXIT W "completed."

 K DA,DIC,DIE,DIK,DR,VAFEDDA,VAFEDX,X,Y Q

DGV53PTE  ;AISC/SAW-Convert EDR data from file 705 to file 391.51 ;7/16/93  16:07

 +1       ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 +2       ;;

 +3        WRITE !!,">>> Converting EDR data from file #705 to file #391.51..."

 +4        SET %X="^EDR(705,"

           SET %Y="^VAT(391.51,"

           DO %XY^%RCR

           SET $PIECE(^VAT(391.51,0),"^",1,2)="PIMS EDR EVENT^391.51D"

           KILL %X,%Y

 +5        SET DIU="^EDR(705,"

           SET DIU(0)="DST"

           DO EN^DIU2

           KILL DIU

 +6        SET DA(1)=+$ORDER(^ORD(101,"B","DGPM MOVEMENT EVENTS",0))

           SET VAFEDX=+$ORDER(^ORD(101,"B","EDR CAPTURE EVENTS",0))

           SET DA=+$ORDER(^ORD(101,"AD",VAFEDX,DA(1),0))

 +7        IF DA(1)

               IF DA

                   SET DIK="^ORD(101,"_DA(1)_",10,"

                   DO ^DIK

 +8        IF VAFEDX

               SET DA=VAFEDX

               SET DIK="^ORD(101,"

               DO ^DIK

 +9       ;I '$D(^HL(770,0)) W !!,*7,"You have not yet initialized the DHCP HL7 package.  Be sure to re-run this part",!,"of the post-init (D ^DGV53PTE) after you initialize the DHCP HL7 package." G EXIT

771        SET VAFEDDA=$ORDER(^HL(771,"B","EDR-MAS",0))

           IF 'VAFEDDA

               KILL DD,DO

               SET X="EDR-MAS"

               SET DIC="^HL(771,"

               SET DIC(0)=""

               DO FILE^DICN

               IF Y<0

                   GOTO 771

               SET (DA,VAFEDDA)=+Y

               SET DIE=DIC

               SET DR="2///I"

               DO ^DIE

770        SET DA=$ORDER(^HL(770,"B","EDR-MAS",0))

           IF 'DA

               KILL DA,DD,DO,DR

               SET X="EDR-MAS"

               SET DIC="^HL(770,"

               SET DIC(0)=""

               DO FILE^DICN

               IF Y<0

                   GOTO 770

               SET DA=+Y

               SET DIE=DIC

               SET DR="3///RCP;4///245;7///2.1;8////"_VAFEDDA_";14///P"

               DO ^DIE

 +1        SET X=$ORDER(^XMB(3.8,"B","EDR-RCP",0))

           IF X

               SET $PIECE(^HL(770,DA,0),"^",10)=X

EXIT       WRITE "completed."

 +1        KILL DA,DIC,DIE,DIK,DR,VAFEDDA,VAFEDX,X,Y

           QUIT