- 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
