AVASLXR ;IHS/DSD/CRG - STATE LICENSE FIELD X-REF ROUTINE [ 07/03/97 1:14 PM ]
;;93.2;VA SUPPORT FILES;**9**;JUL 01, 1993;Build 12
SET ;EP - SET LOGIC
S AVA200=$G(^DIC(16,DA(1),"A3")) Q:'AVA200
S:'$D(^VA(200,AVA200,"PS1",0)) ^(0)="^200.541P^^"
S ^VA(200,AVA200,"PS1",DA,0)=^DIC(6,DA(1),999999921,DA,0)
S ^VA(200,AVA200,"PS1","B",DA,DA)=""
D ZSET
K AVA200
Q
KILL ;EP - KILL LOGIC
S AVA200=$G(^DIC(16,DA(1),"A3")) Q:'AVA200
Q:'$D(^VA(200,AVA200,"PS1"))
K ^VA(200,AVA200,"PS1",DA,0)
K ^VA(200,AVA200,"PS1","B",DA,DA)
D ZSET
K AVA200
Q
ZSET ;RESET ZERO NODE
N I,J S I=0,J="" F S I=$O(^VA(200,AVA200,"PS1",I)) Q:'I D
.S J=J+1
S $P(^VA(200,AVA200,"PS1",0),"^",4)=J,$P(^(0),"^",3)=DA
Q
INSTALL ;EP - INSTALL PATCH
D DINUM
D PRTR I $G(AVAQUIT) W !!,"Update aborted.",!! Q
D IXALL
K AVAQUIT,AVAEQ,AVAPAGE,AVACOUNT,AVADASH
D ^%ZISC
Q
DINUM ;DINUM FILE 200 ENTRIES
S DA(1)=0 F S DA(1)=$O(^VA(200,DA(1))) Q:'DA(1) D
.Q:'$D(^VA(200,DA(1),"PS1"))
.D ONE
K AVASTATE
Q
ONE ;CONVERT ONE FILE 200 ENTRY
M AVATMP=^VA(200,DA(1),"PS1")
K ^VA(200,DA(1),"PS1")
S ^VA(200,DA(1),"PS1",0)="^200.541P^^"
S DA=0 F S DA=$O(AVATMP(DA)) Q:'DA D
.S AVASTATE=$P(AVATMP(DA,0),"^",1)
.S ^VA(200,DA(1),"PS1",AVASTATE,0)=AVATMP(DA,0)
.S ^VA(200,DA(1),"PS1","B",AVASTATE,AVASTATE)=""
.S $P(^VA(200,DA(1),"PS1",0),"^",3)=AVASTATE
.S $P(^VA(200,DA(1),"PS1",0),"^",4)=$P(^(0),"^",4)+1
K AVATMP
Q
PRTR ;SELECT PRINTER FOR REPORT
K AVAQUIT
S %ZIS="",%ZIS("A")="Select device for update report: "
D ^%ZIS I POP D
.S DIR(0)="Y",DIR("A")="Device Not Selected. Continue",DIR("B")="NO"
.D ^DIR K DIR
.I Y'=1 S AVAQUIT=1
Q
IXALL ;X-REF ALL ENTRIES, FILE 6
U IO
S $P(AVAEQ,"=",80)=""
S $P(AVADASH,"-",80)=""
S AVAPAGE=0,AVACOUNT=0 D HDR
S DA(1)=0 F S DA(1)=$O(^DIC(6,DA(1))) Q:'DA(1) D
.S DA=0 F S DA=$O(^DIC(6,DA(1),999999921,DA)) Q:'DA D
..D SET
..S AVACOUNT=AVACOUNT+1
..W !,$P(^DIC(16,DA(1),0),"^",1)
..W ?30,$P(^DIC(5,DA,0),"^",1)
..W ?50,$P(^DIC(6,DA(1),999999921,DA,0),"^",2)
..D:$Y+6>IOSL HDR
W !!,AVACOUNT," Records Processed."
W !!!,"E N D O F R E P O R T",@IOF
Q
HDR ;PRINT HEADER
I '$D(DT) S DT=($$HTFM^XLFDT($H)\1)
U IO
S AVAPAGE=AVAPAGE+1
W @IOF
W !,?25,"STATE LICENSE NUMBER CONVERSION",?65,$$FMTE^XLFDT(DT,"D")
W !,?15,"from file DIC(6 PROVIDER File to VA(200 NEW PERSON File"
W !,AVADASH
W !,"PROVIDER",?30,"STATE",?50,"LICENSE #",?70,"PAGE ",AVAPAGE
W !,AVAEQ,!
Q
AVASLXR ;IHS/DSD/CRG - STATE LICENSE FIELD X-REF ROUTINE [ 07/03/97 1:14 PM ]
+1 ;;93.2;VA SUPPORT FILES;**9**;JUL 01, 1993;Build 12
SET ;EP - SET LOGIC
+1 SET AVA200=$GET(^DIC(16,DA(1),"A3"))
IF 'AVA200
QUIT
+2 IF '$DATA(^VA(200,AVA200,"PS1",0))
SET ^(0)="^200.541P^^"
+3 SET ^VA(200,AVA200,"PS1",DA,0)=^DIC(6,DA(1),999999921,DA,0)
+4 SET ^VA(200,AVA200,"PS1","B",DA,DA)=""
+5 DO ZSET
+6 KILL AVA200
+7 QUIT
KILL ;EP - KILL LOGIC
+1 SET AVA200=$GET(^DIC(16,DA(1),"A3"))
IF 'AVA200
QUIT
+2 IF '$DATA(^VA(200,AVA200,"PS1"))
QUIT
+3 KILL ^VA(200,AVA200,"PS1",DA,0)
+4 KILL ^VA(200,AVA200,"PS1","B",DA,DA)
+5 DO ZSET
+6 KILL AVA200
+7 QUIT
ZSET ;RESET ZERO NODE
+1 NEW I,J
SET I=0
SET J=""
FOR
SET I=$ORDER(^VA(200,AVA200,"PS1",I))
IF 'I
QUIT
Begin DoDot:1
+2 SET J=J+1
End DoDot:1
+3 SET $PIECE(^VA(200,AVA200,"PS1",0),"^",4)=J
SET $PIECE(^(0),"^",3)=DA
+4 QUIT
INSTALL ;EP - INSTALL PATCH
+1 DO DINUM
+2 DO PRTR
IF $GET(AVAQUIT)
WRITE !!,"Update aborted.",!!
QUIT
+3 DO IXALL
+4 KILL AVAQUIT,AVAEQ,AVAPAGE,AVACOUNT,AVADASH
+5 DO ^%ZISC
+6 QUIT
DINUM ;DINUM FILE 200 ENTRIES
+1 SET DA(1)=0
FOR
SET DA(1)=$ORDER(^VA(200,DA(1)))
IF 'DA(1)
QUIT
Begin DoDot:1
+2 IF '$DATA(^VA(200,DA(1),"PS1"))
QUIT
+3 DO ONE
End DoDot:1
+4 KILL AVASTATE
+5 QUIT
ONE ;CONVERT ONE FILE 200 ENTRY
+1 MERGE AVATMP=^VA(200,DA(1),"PS1")
+2 KILL ^VA(200,DA(1),"PS1")
+3 SET ^VA(200,DA(1),"PS1",0)="^200.541P^^"
+4 SET DA=0
FOR
SET DA=$ORDER(AVATMP(DA))
IF 'DA
QUIT
Begin DoDot:1
+5 SET AVASTATE=$PIECE(AVATMP(DA,0),"^",1)
+6 SET ^VA(200,DA(1),"PS1",AVASTATE,0)=AVATMP(DA,0)
+7 SET ^VA(200,DA(1),"PS1","B",AVASTATE,AVASTATE)=""
+8 SET $PIECE(^VA(200,DA(1),"PS1",0),"^",3)=AVASTATE
+9 SET $PIECE(^VA(200,DA(1),"PS1",0),"^",4)=$PIECE(^(0),"^",4)+1
End DoDot:1
+10 KILL AVATMP
+11 QUIT
PRTR ;SELECT PRINTER FOR REPORT
+1 KILL AVAQUIT
+2 SET %ZIS=""
SET %ZIS("A")="Select device for update report: "
+3 DO ^%ZIS
IF POP
Begin DoDot:1
+4 SET DIR(0)="Y"
SET DIR("A")="Device Not Selected. Continue"
SET DIR("B")="NO"
+5 DO ^DIR
KILL DIR
+6 IF Y'=1
SET AVAQUIT=1
End DoDot:1
+7 QUIT
IXALL ;X-REF ALL ENTRIES, FILE 6
+1 USE IO
+2 SET $PIECE(AVAEQ,"=",80)=""
+3 SET $PIECE(AVADASH,"-",80)=""
+4 SET AVAPAGE=0
SET AVACOUNT=0
DO HDR
+5 SET DA(1)=0
FOR
SET DA(1)=$ORDER(^DIC(6,DA(1)))
IF 'DA(1)
QUIT
Begin DoDot:1
+6 SET DA=0
FOR
SET DA=$ORDER(^DIC(6,DA(1),999999921,DA))
IF 'DA
QUIT
Begin DoDot:2
+7 DO SET
+8 SET AVACOUNT=AVACOUNT+1
+9 WRITE !,$PIECE(^DIC(16,DA(1),0),"^",1)
+10 WRITE ?30,$PIECE(^DIC(5,DA,0),"^",1)
+11 WRITE ?50,$PIECE(^DIC(6,DA(1),999999921,DA,0),"^",2)
+12 IF $Y+6>IOSL
DO HDR
End DoDot:2
End DoDot:1
+13 WRITE !!,AVACOUNT," Records Processed."
+14 WRITE !!!,"E N D O F R E P O R T",@IOF
+15 QUIT
HDR ;PRINT HEADER
+1 IF '$DATA(DT)
SET DT=($$HTFM^XLFDT($HOROLOG)\1)
+2 USE IO
+3 SET AVAPAGE=AVAPAGE+1
+4 WRITE @IOF
+5 WRITE !,?25,"STATE LICENSE NUMBER CONVERSION",?65,$$FMTE^XLFDT(DT,"D")
+6 WRITE !,?15,"from file DIC(6 PROVIDER File to VA(200 NEW PERSON File"
+7 WRITE !,AVADASH
+8 WRITE !,"PROVIDER",?30,"STATE",?50,"LICENSE #",?70,"PAGE ",AVAPAGE
+9 WRITE !,AVAEQ,!
+10 QUIT
