- 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
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVPST01 1765 printed Mar 13, 2025@21:36:39 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
