- 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 Mar 13, 2025@21:50:48 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
