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 Nov 22, 2024@17:41:56 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
