HLPAT19.m

HLPAT19 ;SFIRMFO/RSD  Pre & Post Install for HL7 patch 19 ;11/20/98  09:54 [ 04/02/2003   8:37 AM ]

 ;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003

 ;;1.6;HEALTH LEVEL SEVEN;**19**;JUL 17, 1995

 ;

 ;check that conversion already run

 I @XPDGREF@("POST") D BMES^XPDUTL("Conversion already run!") Q

 ;convert pointer in File 772 to Date/Time

 L +^HL(772),+^HLMA

 S XPDIDCNT=0,XPDIDTOT=+$P(^HL(772,0),U,4)

 N DA2,DA3,DIK,MID,MDT,WORK,X,Y

 S (DA2,WORK)=0

 ;find pointers to file 773 = DA3

 F  S DA2=$O(^HL(772,DA2)) Q:'DA2  S DA3=+$G(^(DA2,0)) D:DA3

 . ;quit if pointer to 773 doesn't exist

 . Q:'$D(^HLMA(DA3,0))

 . S MDT=$P(^HLMA(DA3,0),U),WORK=1

 . D CNV2(DA2)

 . S XPDIDCNT=XPDIDCNT+1 D:'(XPDIDCNT#10) UPDATE^XPDID(XPDIDCNT)

 ;

 ;nothing was converted

 I 'WORK L  Q

 ;remove all remaining entries in 773

 S DA3=0

 F  S DA3=$O(^HLMA(DA3)) Q:DA3=""  K ^HLMA(DA3)

 ;re-index file 773

 S DIK="^HLMA(",DIK(1)=.01 D ENALL^DIK

 L

 Q

CNV2(DA) ;convert .01 field in 772 from pointer to Date/Time

 K ^HL(772,"B",DA3,DA)

 S $P(^HL(772,DA,0),U)=MDT,^HL(772,"B",MDT,DA)=""

 Q

HLPAT19   ;SFIRMFO/RSD  Pre & Post Install for HL7 patch 19 ;11/20/98  09:54 [ 04/02/2003   8:37 AM ]

 +1       ;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003

 +2       ;;1.6;HEALTH LEVEL SEVEN;**19**;JUL 17, 1995

 +3       ;

 +4       ;check that conversion already run

 +5        IF @XPDGREF@("POST")

               DO BMES^XPDUTL("Conversion already run!")

               QUIT 

 +6       ;convert pointer in File 772 to Date/Time

 +7        LOCK +^HL(772),+^HLMA

 +8        SET XPDIDCNT=0

           SET XPDIDTOT=+$PIECE(^HL(772,0),U,4)

 +9        NEW DA2,DA3,DIK,MID,MDT,WORK,X,Y

 +10       SET (DA2,WORK)=0

 +11      ;find pointers to file 773 = DA3

 +12       FOR 

               SET DA2=$ORDER(^HL(772,DA2))

               IF 'DA2

                   QUIT 

               SET DA3=+$GET(^(DA2,0))

               IF DA3

                   Begin DoDot:1

 +13      ;quit if pointer to 773 doesn't exist

 +14                   IF '$DATA(^HLMA(DA3,0))

                           QUIT 

 +15                   SET MDT=$PIECE(^HLMA(DA3,0),U)

                       SET WORK=1

 +16                   DO CNV2(DA2)

 +17                   SET XPDIDCNT=XPDIDCNT+1

                       IF '(XPDIDCNT#10)

                           DO UPDATE^XPDID(XPDIDCNT)

                   End DoDot:1

 +18      ;

 +19      ;nothing was converted

 +20       IF 'WORK

               LOCK 

               QUIT 

 +21      ;remove all remaining entries in 773

 +22       SET DA3=0

 +23       FOR 

               SET DA3=$ORDER(^HLMA(DA3))

               IF DA3=""

                   QUIT 

               KILL ^HLMA(DA3)

 +24      ;re-index file 773

 +25       SET DIK="^HLMA("

           SET DIK(1)=.01

           DO ENALL^DIK

 +26       LOCK 

 +27       QUIT 

CNV2(DA)  ;convert .01 field in 772 from pointer to Date/Time

 +1        KILL ^HL(772,"B",DA3,DA)

 +2        SET $PIECE(^HL(772,DA,0),U)=MDT

           SET ^HL(772,"B",MDT,DA)=""

 +3        QUIT