AQAQCONV ;IHS/ANMC/LJF - CONVERSION OF DATA TO NEW CREDENTIALS FILE; [ 07/27/92 5:41 PM ]
;;2.2;STAFF CREDENTIALS;;01 OCT 1992
;
START ;>>> start of MAIN ROUTINE <<<
W !!,"DATA CONVERSION TO NEW CREDENTIALS FILE WILL NOW RUN..."
;
I '$O(^AQAQ(0)) W !!,*7,?10,"NO DATA TO CONVERT-BYPASSING..." Q
I $O(^AQAQC(0)) W !!,*7,?10,"CONVERSION ALREADY RUN-BYPASSING..." Q
;
S U="^"
;
W !!?10,"CONVERSION RUNNING..."
;**> loop thru old file; find entries; do conversions
S AQAQX=0
F S AQAQX=$O(^AQAQ(AQAQX)) Q:AQAQX'=+AQAQX D
.;
.;**> increment zero node
.S $P(^AQAQC(0),U,3)=AQAQX,$P(^(0),U,4)=$P(^(0),U,4)+1
.;
.;**> convert single node data
.D CONVERT1
.;
.;**> convert data in health status multiple
.S AQAQY=0,^AQAQC(AQAQX,"H",0)="^9002165.03D^^"
.F S AQAQY=$O(^AQAQ(AQAQX,6,AQAQY)) Q:AQAQY'=+AQAQY D
..S ^AQAQC(AQAQX,"H",AQAQY,0)=$G(^AQAQ(AQAQX,6,AQAQY,0))
..S $P(^AQAQC(AQAQX,"H",0),U,3)=AQAQY
..S $P(^AQAQC(AQAQX,"H",0),U,4)=$P(^(0),U,4)+1
.;
.;**> convert data in credentials approval multiple
.S AQAQY=$O(^AQAQ(AQAQX,9,0)) I AQAQY=+AQAQY D CONVERT2
.;
.;**> convert med board certification data multiple
.S AQAQY=0,AQAQP=$P(AQAQ0,U) K AQAQA
.;sort old data by board and then by date into array
.F S AQAQY=$O(^AQAQ(AQAQX,1,AQAQY)) Q:AQAQY'=+AQAQY D
..S AQAQS=$G(^AQAQ(AQAQX,1,AQAQY,0))
..Q:$P(AQAQS,U)="" Q:$P(AQAQS,U,2)=""
..S AQAQA($P(AQAQS,U,2),$P(AQAQS,U))=$P(AQAQS,U,3)
.;
.;for each board set original certification plus recert. multiples
.S AQAQB=0
.F S AQAQB=$O(AQAQA(AQAQB)) Q:AQAQB="" D CONVERT3
;
;**> index file
W !!?10,"FIRING CROSS-REFERENCES..."
S DIU(0)="",DIK="^AQAQC(" D IXALL^DIK K DIU(0)
;
END W !!?10,"CONVERSION COMPLETE!!!"
K AQAQ0,AQAQ2,AQAQ7,AQAQ11,AQAQP,AQAQDA,DIC,DIK,X,Y
K AQAQX,AQAQY,AQAQA,AQAQB,AQAQC,AQAQS,AQAQD,AQAQCT Q
;
;>>> end of MAIN ROUTINE <<<
;
;
CONVERT1 ;***> SUBRTN to convert data from single nodes
S AQAQ0=$G(^AQAQ(AQAQX,0))
S AQAQ2=$G(^AQAQ(AQAQX,2))
S AQAQ7=$G(^AQAQ(AQAQX,7))
S AQAQ11=$G(^AQAQ(AQAQX,11))
S $P(^AQAQC(AQAQX,0),U,1,3)=$P(AQAQ0,U,1,3)
S $P(^(0),U,11)=$P(AQAQ0,U,4),$P(^(0),U,7)=$P(AQAQ0,U,5)
S $P(^(0),U,5)=$P(AQAQ0,U,6),$P(^(0),U,6)=$P(AQAQ0,U,14)
S $P(^(0),U,13)=$P(AQAQ0,U,9),$P(^(0),U,15)=$P(AQAQ0,U,11)
S $P(^(0),U,14)=$P(AQAQ0,U,10)
I $P(AQAQ0,U,13)="Y" S $P(^(0),U,17,18)="3^Y"
S $P(^AQAQC(AQAQX,0),U,19)=AQAQ2
S $P(^AQAQC(AQAQX,2),U,3)=$P(AQAQ7,U)
S $P(^AQAQC(AQAQX,2),U,1,2)=$P(AQAQ11,U,2,3)
S $P(^(2),U,4)=$P(AQAQ11,U)
Q
;
;
CONVERT2 ;***> SUBRTN to move credentials approval data to reappointment multi
S $P(^AQAQC(AQAQX,0),U,4)=$P($G(^AQAQ(AQAQX,9,AQAQY,0)),U)
S ^AQAQC(AQAQX,"R",0)="^9002165.01D^^",AQAQY=0
F S AQAQY=$O(^AQAQ(AQAQX,9,AQAQY)) Q:AQAQY'=+AQAQY D
.S $P(^AQAQC(AQAQX,"R",AQAQY,0),U)=$E($P($G(^AQAQ(AQAQX,9,AQAQY,0)),U),1,5)_"00"
.S $P(^AQAQC(AQAQX,"R",AQAQY,0),U,2)=$P($G(^AQAQ(AQAQX,9,AQAQY,0)),U)
.S $P(^AQAQC(AQAQX,"R",0),U,3)=AQAQY
.S $P(^AQAQC(AQAQX,"R",0),U,4)=$P(^(0),U,4)+1
Q
;
;
CONVERT3 ;***> SUBRTN to move med board data to Med Board Certification file
S AQAQD=$O(AQAQA(AQAQB,0)),DIC="^AQAQMB(",DIC(0)="L",X=AQAQB
S DIC("DR")=".02///^S X=""`""_AQAQP;.03///^S X=AQAQD;.04///^S X=AQAQA(AQAQB,AQAQD)"
D FILE^DICN S AQAQDA=+Y
;create recertification date multiples for that board
S ^AQAQMB(AQAQDA,1,0)="^9002161.11D^^",AQAQCT=0
F S AQAQD=$O(AQAQA(AQAQB,AQAQD)) Q:AQAQD="" D
.S AQAQCT=AQAQCT+1,$P(^AQAQMB(AQAQDA,1,0),U,3)=AQAQCT
.S $P(^AQAQMB(AQAQDA,1,0),U,4)=$P(^(0),U,4)+1
.S ^AQAQMB(AQAQDA,1,AQAQCT,0)=AQAQD_U_AQAQA(AQAQB,AQAQD)
Q
AQAQCONV ;IHS/ANMC/LJF - CONVERSION OF DATA TO NEW CREDENTIALS FILE; [ 07/27/92 5:41 PM ]
+1 ;;2.2;STAFF CREDENTIALS;;01 OCT 1992
+2 ;
START ;>>> start of MAIN ROUTINE <<<
+1 WRITE !!,"DATA CONVERSION TO NEW CREDENTIALS FILE WILL NOW RUN..."
+2 ;
+3 IF '$ORDER(^AQAQ(0))
WRITE !!,*7,?10,"NO DATA TO CONVERT-BYPASSING..."
QUIT
+4 IF $ORDER(^AQAQC(0))
WRITE !!,*7,?10,"CONVERSION ALREADY RUN-BYPASSING..."
QUIT
+5 ;
+6 SET U="^"
+7 ;
+8 WRITE !!?10,"CONVERSION RUNNING..."
+9 ;**> loop thru old file; find entries; do conversions
+10 SET AQAQX=0
+11 FOR
SET AQAQX=$ORDER(^AQAQ(AQAQX))
IF AQAQX'=+AQAQX
QUIT
Begin DoDot:1
+12 ;
+13 ;**> increment zero node
+14 SET $PIECE(^AQAQC(0),U,3)=AQAQX
SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
+15 ;
+16 ;**> convert single node data
+17 DO CONVERT1
+18 ;
+19 ;**> convert data in health status multiple
+20 SET AQAQY=0
SET ^AQAQC(AQAQX,"H",0)="^9002165.03D^^"
+21 FOR
SET AQAQY=$ORDER(^AQAQ(AQAQX,6,AQAQY))
IF AQAQY'=+AQAQY
QUIT
Begin DoDot:2
+22 SET ^AQAQC(AQAQX,"H",AQAQY,0)=$GET(^AQAQ(AQAQX,6,AQAQY,0))
+23 SET $PIECE(^AQAQC(AQAQX,"H",0),U,3)=AQAQY
+24 SET $PIECE(^AQAQC(AQAQX,"H",0),U,4)=$PIECE(^(0),U,4)+1
End DoDot:2
+25 ;
+26 ;**> convert data in credentials approval multiple
+27 SET AQAQY=$ORDER(^AQAQ(AQAQX,9,0))
IF AQAQY=+AQAQY
DO CONVERT2
+28 ;
+29 ;**> convert med board certification data multiple
+30 SET AQAQY=0
SET AQAQP=$PIECE(AQAQ0,U)
KILL AQAQA
+31 ;sort old data by board and then by date into array
+32 FOR
SET AQAQY=$ORDER(^AQAQ(AQAQX,1,AQAQY))
IF AQAQY'=+AQAQY
QUIT
Begin DoDot:2
+33 SET AQAQS=$GET(^AQAQ(AQAQX,1,AQAQY,0))
+34 IF $PIECE(AQAQS,U)=""
QUIT
IF $PIECE(AQAQS,U,2)=""
QUIT
+35 SET AQAQA($PIECE(AQAQS,U,2),$PIECE(AQAQS,U))=$PIECE(AQAQS,U,3)
End DoDot:2
+36 ;
+37 ;for each board set original certification plus recert. multiples
+38 SET AQAQB=0
+39 FOR
SET AQAQB=$ORDER(AQAQA(AQAQB))
IF AQAQB=""
QUIT
DO CONVERT3
End DoDot:1
+40 ;
+41 ;**> index file
+42 WRITE !!?10,"FIRING CROSS-REFERENCES..."
+43 SET DIU(0)=""
SET DIK="^AQAQC("
DO IXALL^DIK
KILL DIU(0)
+44 ;
END WRITE !!?10,"CONVERSION COMPLETE!!!"
+1 KILL AQAQ0,AQAQ2,AQAQ7,AQAQ11,AQAQP,AQAQDA,DIC,DIK,X,Y
+2 KILL AQAQX,AQAQY,AQAQA,AQAQB,AQAQC,AQAQS,AQAQD,AQAQCT
QUIT
+3 ;
+4 ;>>> end of MAIN ROUTINE <<<
+5 ;
+6 ;
CONVERT1 ;***> SUBRTN to convert data from single nodes
+1 SET AQAQ0=$GET(^AQAQ(AQAQX,0))
+2 SET AQAQ2=$GET(^AQAQ(AQAQX,2))
+3 SET AQAQ7=$GET(^AQAQ(AQAQX,7))
+4 SET AQAQ11=$GET(^AQAQ(AQAQX,11))
+5 SET $PIECE(^AQAQC(AQAQX,0),U,1,3)=$PIECE(AQAQ0,U,1,3)
+6 SET $PIECE(^(0),U,11)=$PIECE(AQAQ0,U,4)
SET $PIECE(^(0),U,7)=$PIECE(AQAQ0,U,5)
+7 SET $PIECE(^(0),U,5)=$PIECE(AQAQ0,U,6)
SET $PIECE(^(0),U,6)=$PIECE(AQAQ0,U,14)
+8 SET $PIECE(^(0),U,13)=$PIECE(AQAQ0,U,9)
SET $PIECE(^(0),U,15)=$PIECE(AQAQ0,U,11)
+9 SET $PIECE(^(0),U,14)=$PIECE(AQAQ0,U,10)
+10 IF $PIECE(AQAQ0,U,13)="Y"
SET $PIECE(^(0),U,17,18)="3^Y"
+11 SET $PIECE(^AQAQC(AQAQX,0),U,19)=AQAQ2
+12 SET $PIECE(^AQAQC(AQAQX,2),U,3)=$PIECE(AQAQ7,U)
+13 SET $PIECE(^AQAQC(AQAQX,2),U,1,2)=$PIECE(AQAQ11,U,2,3)
+14 SET $PIECE(^(2),U,4)=$PIECE(AQAQ11,U)
+15 QUIT
+16 ;
+17 ;
CONVERT2 ;***> SUBRTN to move credentials approval data to reappointment multi
+1 SET $PIECE(^AQAQC(AQAQX,0),U,4)=$PIECE($GET(^AQAQ(AQAQX,9,AQAQY,0)),U)
+2 SET ^AQAQC(AQAQX,"R",0)="^9002165.01D^^"
SET AQAQY=0
+3 FOR
SET AQAQY=$ORDER(^AQAQ(AQAQX,9,AQAQY))
IF AQAQY'=+AQAQY
QUIT
Begin DoDot:1
+4 SET $PIECE(^AQAQC(AQAQX,"R",AQAQY,0),U)=$EXTRACT($PIECE($GET(^AQAQ(AQAQX,9,AQAQY,0)),U),1,5)_"00"
+5 SET $PIECE(^AQAQC(AQAQX,"R",AQAQY,0),U,2)=$PIECE($GET(^AQAQ(AQAQX,9,AQAQY,0)),U)
+6 SET $PIECE(^AQAQC(AQAQX,"R",0),U,3)=AQAQY
+7 SET $PIECE(^AQAQC(AQAQX,"R",0),U,4)=$PIECE(^(0),U,4)+1
End DoDot:1
+8 QUIT
+9 ;
+10 ;
CONVERT3 ;***> SUBRTN to move med board data to Med Board Certification file
+1 SET AQAQD=$ORDER(AQAQA(AQAQB,0))
SET DIC="^AQAQMB("
SET DIC(0)="L"
SET X=AQAQB
+2 SET DIC("DR")=".02///^S X=""`""_AQAQP;.03///^S X=AQAQD;.04///^S X=AQAQA(AQAQB,AQAQD)"
+3 DO FILE^DICN
SET AQAQDA=+Y
+4 ;create recertification date multiples for that board
+5 SET ^AQAQMB(AQAQDA,1,0)="^9002161.11D^^"
SET AQAQCT=0
+6 FOR
SET AQAQD=$ORDER(AQAQA(AQAQB,AQAQD))
IF AQAQD=""
QUIT
Begin DoDot:1
+7 SET AQAQCT=AQAQCT+1
SET $PIECE(^AQAQMB(AQAQDA,1,0),U,3)=AQAQCT
+8 SET $PIECE(^AQAQMB(AQAQDA,1,0),U,4)=$PIECE(^(0),U,4)+1
+9 SET ^AQAQMB(AQAQDA,1,AQAQCT,0)=AQAQD_U_AQAQA(AQAQB,AQAQD)
End DoDot:1
+10 QUIT
