Routine: PXVPST01

PXVPST01 ;BIR/CML3 - V IMMUNIZATION FILE CONVERSION ; 26 Sep 2014  9:38 AM

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**201**;Aug 12, 1996;Build 41

MVDIAGS ;

 ; moves the data in the previous DIAGNOSIS fields to the new fields:

 ; the PRIMARY DIAGNOSIS (#1304) and the OTHER DIAGNOSIS (#3) multiple

 ; this is a one-time task

 ; ^AUPNVIMM( is the V IMMUNIZATION file (#9000010.11)

 ; PXVV is the IENs of that file

 ; PXVD are pieces 8-15 of the zero node, where the data for the

 ; previous diagnosis fields (#s .08 thru .15) is stored

 N %,%H,%I,CNT,DA,DIC,DIE,DIK,DR,Q,X,Y,PXVD,PXVNOW,PXVV

 D NOW^%DTC S Y=% D DD^%DT S PXVNOW=Y

 D BMES^XPDUTL("Moving the DIAGNOSIS data of the V IMMUNIZATION file to the global locations of the new fields (in the same file).  Process started "_PXVNOW)

 S (CNT,PXVV)=0

 F  S PXVV=$O(^AUPNVIMM(PXVV)) Q:'PXVV  S PXVD=$P($G(^(PXVV,0)),"^",8,15) I PXVD'="",PXVD'?1.7"^" D  ;

 . ; DIAGNOSIS becomes PRIMARY DIAGNOSIS

 . S CNT=CNT+1,X=$P(PXVD,"^")

 . I X'="" K DA S DIE="^AUPNVIMM(",DA=PXVV,DR="1304////"_X D ^DIE S $P(^AUPNVIMM(PXVV,0),"^",8)=""

 . ; DIAGNOSES 2-8 become entries in the OTHER DIAGNOSIS multiple

 . F Q=2:1:8 S X=$P(PXVD,"^",Q) I X'="" D  ;

 .. K DA,DIC S DIC="^AUPNVIMM("_PXVV_",3,",DIC(0)="L",DA(1)=PXVV

 .. D FILE^DICN S $P(^AUPNVIMM(PXVV,0),"^",Q+7)=""

MVDONE ; DIAGNOSIS data move completed

 D NOW^%DTC S Y=% D DD^%DT S PXVNOW=Y

 K Q S Q(1)=" ",Q(3)=" "_CNT_" entr"_$S(CNT'=1:"ies",1:"y")_" processed."

 S Q(2)=" Process moving DIAGNOSIS data within the V IMMUNIZATION file completed at "_PXVNOW

 D BMES^XPDUTL(.Q)

RMVFLD ;

 ; following code no longer needed . . .

 ; I $P($G(^DD(9000010.11,.1,0)),"^")="DIAGNOSIS 3" K DA S DIK="^DD(9000010.11,",DA=.1,DA(1)=9000010.11 D ^DIK

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVPST01   1765     printed  Apr 09, 2024@21:30:20                                                                                                                                                                                                    Page 2

PXVPST01  ;BIR/CML3 - V IMMUNIZATION FILE CONVERSION ; 26 Sep 2014  9:38 AM

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**201**;Aug 12, 1996;Build 41

 +2       ;

MVDIAGS   ;

 +1       ; moves the data in the previous DIAGNOSIS fields to the new fields:

 +2       ; the PRIMARY DIAGNOSIS (#1304) and the OTHER DIAGNOSIS (#3) multiple

 +3       ; this is a one-time task

 +4       ; ^AUPNVIMM( is the V IMMUNIZATION file (#9000010.11)

 +5       ; PXVV is the IENs of that file

 +6       ; PXVD are pieces 8-15 of the zero node, where the data for the

 +7       ; previous diagnosis fields (#s .08 thru .15) is stored

 +8        NEW %,%H,%I,CNT,DA,DIC,DIE,DIK,DR,Q,X,Y,PXVD,PXVNOW,PXVV

 +9        DO NOW^%DTC

           SET Y=%

           DO DD^%DT

           SET PXVNOW=Y

 +10       DO BMES^XPDUTL("Moving the DIAGNOSIS data of the V IMMUNIZATION file to the global locations of the new fields (in the same file).  Process started "_PXVNOW)

 +11       SET (CNT,PXVV)=0

 +12      ;

FOR

               SET PXVV=$ORDER(^AUPNVIMM(PXVV))

               if 'PXVV

                   QUIT

               SET PXVD=$PIECE($GET(^(PXVV,0)),"^",8,15)

               IF PXVD'=""

                   IF PXVD'?1.7"^"

                       Begin DoDot:1

 +13      ; DIAGNOSIS becomes PRIMARY DIAGNOSIS

 +14                       SET CNT=CNT+1

                           SET X=$PIECE(PXVD,"^")

 +15                       IF X'=""

                               KILL DA

                               SET DIE="^AUPNVIMM("

                               SET DA=PXVV

                               SET DR="1304////"_X

                               DO ^DIE

                               SET $PIECE(^AUPNVIMM(PXVV,0),"^",8)=""

 +16      ; DIAGNOSES 2-8 become entries in the OTHER DIAGNOSIS multiple

 +17      ;

                           FOR Q=2:1:8

                               SET X=$PIECE(PXVD,"^",Q)

                               IF X'=""

                                   Begin DoDot:2

 +18                                   KILL DA,DIC

                                       SET DIC="^AUPNVIMM("_PXVV_",3,"

                                       SET DIC(0)="L"

                                       SET DA(1)=PXVV

 +19                                   DO FILE^DICN

                                       SET $PIECE(^AUPNVIMM(PXVV,0),"^",Q+7)=""

                                   End DoDot:2

                       End DoDot:1

 +20      ;

MVDONE    ; DIAGNOSIS data move completed

 +1        DO NOW^%DTC

           SET Y=%

           DO DD^%DT

           SET PXVNOW=Y

 +2        KILL Q

           SET Q(1)=" "

           SET Q(3)=" "_CNT_" entr"_$SELECT(CNT'=1:"ies",1:"y")_" processed."

 +3        SET Q(2)=" Process moving DIAGNOSIS data within the V IMMUNIZATION file completed at "_PXVNOW

 +4        DO BMES^XPDUTL(.Q)

 +5       ;

RMVFLD    ;

 +1       ; following code no longer needed . . .

 +2       ; I $P($G(^DD(9000010.11,.1,0)),"^")="DIAGNOSIS 3" K DA S DIK="^DD(9000010.11,",DA=.1,DA(1)=9000010.11 D ^DIK

 +3        QUIT

PXVPST01.m