ANRVPOST ;BHAM/MAM - POST-INIT FOR VERSION 4.0 ; 09 Jun 98 / 8:28 AM
;;4.0; Visual Impairment Service Team ;;12 Jun 98
EN ; update Entry in the PACKAGE file
K DIC,X S X="VISUAL IMPAIRMENT SERVICE",DIC(0)="XZ",DIC="^DIC(9.4," D ^DIC K DIC S X=+Y
I X>0,$P(^DIC(9.4,X,0),"^",1)'="VISUAL IMPAIRMENT SERVICE TEAM" S ANRVNM="VISUAL IMPAIRMENT SERVICE TEAM" D NAME
K ANRVNM,X,Y,DIC,DA,DR,DIE
;Check to see if data has already been moved
I $O(^ANRV(2040,0)) W !!,"It appears that the Visual Impairment Service Team softare V. 4.0 has",!,"already been installed and files have been updated.",! D CLEAN Q
VIRGIN ;Check for virgin install
I '$D(^DIZ(623158,0)) Q
CONVERT ; convert data from ^DIZ( to ^ANRV(
; VIST Letter
S %X="^DIZ(623033,",%Y="^ANRV(2043," D %XY^%RCR S $P(^ANRV(2043,0),"^",2)=2043
S ANRVEN=0 F S ANRVEN=$O(^ANRV(2043,ANRVEN)) Q:'ANRVEN S:$D(^ANRV(2043,ANRVEN,1,0)) $P(^(0),"^",2)=2043.01
; VARO Claims
S %X="^DIZ(623036,",%Y="^ANRV(2043.5," D %XY^%RCR S $P(^ANRV(2043.5,0),"^",2)="2043.5P"
S ANRVEN=0 F S ANRVEN=$O(^ANRV(2043.5,ANRVEN)) Q:'ANRVEN S:$D(^ANRV(2043.5,ANRVEN,1,0)) $P(^(0),"^",2)="2043.51D"
; VIST Eye Diagnosis
S %X="^DIZ(623049,",%Y="^ANRV(2041.5," D %XY^%RCR S $P(^ANRV(2041.5,0),"^",2)=2041.5
; VIST Parameters
S %X="^DIZ(623050,",%Y="^ANRV(2041," D %XY^%RCR S $P(^ANRV(2041,0),"^",2)="2041P"
; VIST Checklist Options
S %X="^DIZ(623053,",%Y="^ANRV(2041.6," D %XY^%RCR S $P(^ANRV(2041.6,0),"^",2)=2041.6
; VIST Benefits and Services Checklist
S %X="^DIZ(623061,",%Y="^ANRV(2041.7," D %XY^%RCR S $P(^ANRV(2041.7,0),"^",2)="2041.7P"
S ANRVEN=0 F S ANRVEN=$O(^ANRV(2041.7,ANRVEN)) Q:'ANRVEN S:$D(^ANRV(2041.7,ANRVEN,2,0)) $P(^(0),"^",2)="2041.732P"
; VIST Local Benefits and Services
S %X="^DIZ(623064,",%Y="^ANRV(2044," D %XY^%RCR S $P(^ANRV(2044,0),"^",2)="2044P"
; VIST Roster
S %X="^DIZ(623158,",%Y="^ANRV(2040," D %XY^%RCR S $P(^ANRV(2040,0),"^",2)="2040IP"
S ANRVEN=0 F S ANRVEN=$O(^ANRV(2040,ANRVEN)) Q:'ANRVEN D
.S:$D(^ANRV(2040,ANRVEN,1,0)) $P(^(0),"^",2)=2040.02
.S:$D(^ANRV(2040,ANRVEN,3,0)) $P(^(0),"^",2)="2040.04D"
.S:$D(^ANRV(2040,ANRVEN,4,0)) $P(^(0),"^",2)=2040.05
.S:$D(^ANRV(2040,ANRVEN,6,0)) $P(^(0),"^",2)="2040.06D"
.S:$D(^ANRV(2040,ANRVEN,8,0)) $P(^(0),"^",2)="2040.014DA"
.S:$D(^ANRV(2040,ANRVEN,10,0)) $P(^(0),"^",2)="2040.03D"
.S:$D(^ANRV(2040,ANRVEN,11,0)) $P(^(0),"^",2)=2040.012
.S:$D(^ANRV(2040,ANRVEN,12,0)) $P(^(0),"^",2)=2040.013
.S:$D(^ANRV(2040,ANRVEN,14,0)) $P(^(0),"^",2)="2040.07D"
.S:$D(^ANRV(2040,ANRVEN,15,0)) $P(^(0),"^",2)="2040.01P"
.S:$D(^ANRV(2040,ANRVEN,16,0)) $P(^(0),"^",2)=2040.08
.S:$D(^ANRV(2040,ANRVEN,17,0)) $P(^(0),"^",2)=2040.09
.S:$D(^ANRV(2040,ANRVEN,18,0)) $P(^(0),"^",2)=2040.1
.S:$D(^ANRV(2040,ANRVEN,19,0)) $P(^(0),"^",2)=2040.11
.S:$D(^ANRV(2040,ANRVEN,20,0)) $P(^(0),"^",2)=2040.12
; VIST Referral Roster
S %X="^DIZ(623160,",%Y="^ANRV(2042.5," D %XY^%RCR S $P(^ANRV(2042.5,0),"^",2)="2042.5P"
S ANRVEN=0 F S ANRVEN=$O(^ANRV(2042.5,ANRVEN)) Q:'ANRVEN S:$D(^ANRV(2042.5,ANRVEN,1,0)) $P(^(0),"^",2)="2042.51D"
; VIST Referral Facility
S %X="^DIZ(623165,",%Y="^ANRV(2042," D %XY^%RCR S $P(^ANRV(2042,0),"^",2)=2042
K ANRVEN
DELETE ; delete files in ^DIZ(623000 numberspace
F ANRVI=623033,623036,623049,623050,623053,623061,623064,623158,623160,623165 S DIU="^DIZ("_ANRVI_",",DIU(0)="DT" D EN^DIU2 K DIU
;
CLEAN ;Cleanup old entries in 2041.7 which have no corresponding entry in 2040.
S ANRVP=0 F S ANRVP=$O(^ANRV(2041.7,ANRVP)) Q:'ANRVP S ANRVP2=+$G(^ANRV(2041.7,+ANRVP,0)) I '$D(^ANRV(2040,+ANRVP2,0)) S DIK="^ANRV(2041.7,",DA=+ANRVP D ^DIK K DIK,DA
;Cleanup old entries in 2042.5 which have no corresponding entry in 2040.
S ANRVP=0 F S ANRVP=$O(^ANRV(2042.5,ANRVP)) Q:'ANRVP S ANRVP2=+$G(^ANRV(2042.5,+ANRVP,0)) I '$D(^ANRV(2040,+ANRVP2,0)) S DIK="^ANRV(2042.5,",DA=+ANRVP D ^DIK K DIK,DA
;Cleanup old entries in 2043.5 which have no corresponding entry in 2040.
S ANRVP=0 F S ANRVP=$O(^ANRV(2043.5,ANRVP)) Q:'ANRVP S ANRVP2=+$G(^ANRV(2043.5,+ANRVP,0)) I '$D(^ANRV(2040,+ANRVP2,0)) S DIK="^ANRV(2043.5,",DA=+ANRVP D ^DIK K DIK,DA
K ANRVP
QUIT K ANRVI
Q
;
NAME ; reset NAME in PACKAGE file
S DIE=9.4,DA=X,DR=".01///"_ANRVNM D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HANRVPOST 4262 printed Apr 09, 2024@21:48:07 Page 2
ANRVPOST ;BHAM/MAM - POST-INIT FOR VERSION 4.0 ; 09 Jun 98 / 8:28 AM
+1 ;;4.0; Visual Impairment Service Team ;;12 Jun 98
EN ; update Entry in the PACKAGE file
+1 KILL DIC,X
SET X="VISUAL IMPAIRMENT SERVICE"
SET DIC(0)="XZ"
SET DIC="^DIC(9.4,"
DO ^DIC
KILL DIC
SET X=+Y
+2 IF X>0
IF $PIECE(^DIC(9.4,X,0),"^",1)'="VISUAL IMPAIRMENT SERVICE TEAM"
SET ANRVNM="VISUAL IMPAIRMENT SERVICE TEAM"
DO NAME
+3 KILL ANRVNM,X,Y,DIC,DA,DR,DIE
+4 ;Check to see if data has already been moved
+5 IF $ORDER(^ANRV(2040,0))
WRITE !!,"It appears that the Visual Impairment Service Team softare V. 4.0 has",!,"already been installed and files have been updated.",!
DO CLEAN
QUIT
VIRGIN ;Check for virgin install
+1 IF '$DATA(^DIZ(623158,0))
QUIT
CONVERT ; convert data from ^DIZ( to ^ANRV(
+1 ; VIST Letter
+2 SET %X="^DIZ(623033,"
SET %Y="^ANRV(2043,"
DO %XY^%RCR
SET $PIECE(^ANRV(2043,0),"^",2)=2043
+3 SET ANRVEN=0
FOR
SET ANRVEN=$ORDER(^ANRV(2043,ANRVEN))
if 'ANRVEN
QUIT
if $DATA(^ANRV(2043,ANRVEN,1,0))
SET $PIECE(^(0),"^",2)=2043.01
+4 ; VARO Claims
+5 SET %X="^DIZ(623036,"
SET %Y="^ANRV(2043.5,"
DO %XY^%RCR
SET $PIECE(^ANRV(2043.5,0),"^",2)="2043.5P"
+6 SET ANRVEN=0
FOR
SET ANRVEN=$ORDER(^ANRV(2043.5,ANRVEN))
if 'ANRVEN
QUIT
if $DATA(^ANRV(2043.5,ANRVEN,1,0))
SET $PIECE(^(0),"^",2)="2043.51D"
+7 ; VIST Eye Diagnosis
+8 SET %X="^DIZ(623049,"
SET %Y="^ANRV(2041.5,"
DO %XY^%RCR
SET $PIECE(^ANRV(2041.5,0),"^",2)=2041.5
+9 ; VIST Parameters
+10 SET %X="^DIZ(623050,"
SET %Y="^ANRV(2041,"
DO %XY^%RCR
SET $PIECE(^ANRV(2041,0),"^",2)="2041P"
+11 ; VIST Checklist Options
+12 SET %X="^DIZ(623053,"
SET %Y="^ANRV(2041.6,"
DO %XY^%RCR
SET $PIECE(^ANRV(2041.6,0),"^",2)=2041.6
+13 ; VIST Benefits and Services Checklist
+14 SET %X="^DIZ(623061,"
SET %Y="^ANRV(2041.7,"
DO %XY^%RCR
SET $PIECE(^ANRV(2041.7,0),"^",2)="2041.7P"
+15 SET ANRVEN=0
FOR
SET ANRVEN=$ORDER(^ANRV(2041.7,ANRVEN))
if 'ANRVEN
QUIT
if $DATA(^ANRV(2041.7,ANRVEN,2,0))
SET $PIECE(^(0),"^",2)="2041.732P"
+16 ; VIST Local Benefits and Services
+17 SET %X="^DIZ(623064,"
SET %Y="^ANRV(2044,"
DO %XY^%RCR
SET $PIECE(^ANRV(2044,0),"^",2)="2044P"
+18 ; VIST Roster
+19 SET %X="^DIZ(623158,"
SET %Y="^ANRV(2040,"
DO %XY^%RCR
SET $PIECE(^ANRV(2040,0),"^",2)="2040IP"
+20 SET ANRVEN=0
FOR
SET ANRVEN=$ORDER(^ANRV(2040,ANRVEN))
if 'ANRVEN
QUIT
Begin DoDot:1
+21 if $DATA(^ANRV(2040,ANRVEN,1,0))
SET $PIECE(^(0),"^",2)=2040.02
+22 if $DATA(^ANRV(2040,ANRVEN,3,0))
SET $PIECE(^(0),"^",2)="2040.04D"
+23 if $DATA(^ANRV(2040,ANRVEN,4,0))
SET $PIECE(^(0),"^",2)=2040.05
+24 if $DATA(^ANRV(2040,ANRVEN,6,0))
SET $PIECE(^(0),"^",2)="2040.06D"
+25 if $DATA(^ANRV(2040,ANRVEN,8,0))
SET $PIECE(^(0),"^",2)="2040.014DA"
+26 if $DATA(^ANRV(2040,ANRVEN,10,0))
SET $PIECE(^(0),"^",2)="2040.03D"
+27 if $DATA(^ANRV(2040,ANRVEN,11,0))
SET $PIECE(^(0),"^",2)=2040.012
+28 if $DATA(^ANRV(2040,ANRVEN,12,0))
SET $PIECE(^(0),"^",2)=2040.013
+29 if $DATA(^ANRV(2040,ANRVEN,14,0))
SET $PIECE(^(0),"^",2)="2040.07D"
+30 if $DATA(^ANRV(2040,ANRVEN,15,0))
SET $PIECE(^(0),"^",2)="2040.01P"
+31 if $DATA(^ANRV(2040,ANRVEN,16,0))
SET $PIECE(^(0),"^",2)=2040.08
+32 if $DATA(^ANRV(2040,ANRVEN,17,0))
SET $PIECE(^(0),"^",2)=2040.09
+33 if $DATA(^ANRV(2040,ANRVEN,18,0))
SET $PIECE(^(0),"^",2)=2040.1
+34 if $DATA(^ANRV(2040,ANRVEN,19,0))
SET $PIECE(^(0),"^",2)=2040.11
+35 if $DATA(^ANRV(2040,ANRVEN,20,0))
SET $PIECE(^(0),"^",2)=2040.12
End DoDot:1
+36 ; VIST Referral Roster
+37 SET %X="^DIZ(623160,"
SET %Y="^ANRV(2042.5,"
DO %XY^%RCR
SET $PIECE(^ANRV(2042.5,0),"^",2)="2042.5P"
+38 SET ANRVEN=0
FOR
SET ANRVEN=$ORDER(^ANRV(2042.5,ANRVEN))
if 'ANRVEN
QUIT
if $DATA(^ANRV(2042.5,ANRVEN,1,0))
SET $PIECE(^(0),"^",2)="2042.51D"
+39 ; VIST Referral Facility
+40 SET %X="^DIZ(623165,"
SET %Y="^ANRV(2042,"
DO %XY^%RCR
SET $PIECE(^ANRV(2042,0),"^",2)=2042
+41 KILL ANRVEN
DELETE ; delete files in ^DIZ(623000 numberspace
+1 FOR ANRVI=623033,623036,623049,623050,623053,623061,623064,623158,623160,623165
SET DIU="^DIZ("_ANRVI_","
SET DIU(0)="DT"
DO EN^DIU2
KILL DIU
+2 ;
CLEAN ;Cleanup old entries in 2041.7 which have no corresponding entry in 2040.
+1 SET ANRVP=0
FOR
SET ANRVP=$ORDER(^ANRV(2041.7,ANRVP))
if 'ANRVP
QUIT
SET ANRVP2=+$GET(^ANRV(2041.7,+ANRVP,0))
IF '$DATA(^ANRV(2040,+ANRVP2,0))
SET DIK="^ANRV(2041.7,"
SET DA=+ANRVP
DO ^DIK
KILL DIK,DA
+2 ;Cleanup old entries in 2042.5 which have no corresponding entry in 2040.
+3 SET ANRVP=0
FOR
SET ANRVP=$ORDER(^ANRV(2042.5,ANRVP))
if 'ANRVP
QUIT
SET ANRVP2=+$GET(^ANRV(2042.5,+ANRVP,0))
IF '$DATA(^ANRV(2040,+ANRVP2,0))
SET DIK="^ANRV(2042.5,"
SET DA=+ANRVP
DO ^DIK
KILL DIK,DA
+4 ;Cleanup old entries in 2043.5 which have no corresponding entry in 2040.
+5 SET ANRVP=0
FOR
SET ANRVP=$ORDER(^ANRV(2043.5,ANRVP))
if 'ANRVP
QUIT
SET ANRVP2=+$GET(^ANRV(2043.5,+ANRVP,0))
IF '$DATA(^ANRV(2040,+ANRVP2,0))
SET DIK="^ANRV(2043.5,"
SET DA=+ANRVP
DO ^DIK
KILL DIK,DA
+6 KILL ANRVP
QUIT KILL ANRVI
+1 QUIT
+2 ;
NAME ; reset NAME in PACKAGE file
+1 SET DIE=9.4
SET DA=X
SET DR=".01///"_ANRVNM
DO ^DIE
+2 QUIT
