ACD4P1P ;IHS/ADC/EDE/KML - POST-INIT CONVERSIONS FOR V4.1;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;
START ;
W !!,"Beginning the post-init routine ",$T(+0)
W !!,"Installing Protocols..." D ^ACDONIT
W !!,"Installing List templates..." D ^ACDL
I $D(^TMP("ACD",$J,"VIRGIN INSTALL")) W !!,"Virgin install so post-init not necessary.",! K ^TMP("ACD",$J) Q
I '$G(DUZ)!($G(DUZ(0))'["@") W !!,"Either DUZ is not set or you do not have programmer access. I don't",!,"know how you got here but I cannot run this post-int routine.",!! Q
D PGMFIX ; kill most program data
D VXREFS ; kill CDMIS VISIT xrefs
D SERVICE ; convert CDMIS SERVICE file
D LOCATION ; convert CDMIS LOCATION file
D COMPONEN ; convert CDMIS COMPONENT file
D REPOINT ; repoint data files
D TOBACCO ; fix tobacco debacle
D PROBS ; delete problems
D FILE200 ; convert file 6 ptrs to file 200 ptrs
D GBLKILL ; kill file gbls to be restored
D EOJ
Q
;
PGMFIX ; DELETE PROGRAM DATA
S ACDPGM=0
F S ACDPGM=$O(^ACDF5PI(ACDPGM)) Q:'ACDPGM D
. S ACDN11=$G(^ACDF5PI(ACDPGM,11))
. S DIK="^ACDF5PI(",DA=ACDPGM
. D DIK^ACDFMC
. S DIC="^ACDF5PI(",X="`"_ACDPGM,DIC(0)="LQ",DLAYGO=9002173
. D DIC^ACDFMC
. Q:ACDN11=""
. S ^ACDF5PI(ACDPGM,11)=ACDN11
. Q
Q
;
VXREFS ; KILL CDMIS VISIT XREFS
K ^ACDVIS("E")
K ^ACDVIS("F")
K ^ACDVIS("G")
K ^ACDVIS("H")
Q
;
SERVICE ; DELETE CDMIS SERVICE TP AND TPR
W !!,"Now converting your CDMIS SERVICE file."
S ACDSIEN("TP")=$O(^ACDSERV("C","TP",0))
I ACDSIEN("TP") S DIK="^ACDSERV(",DA=ACDSIEN("TP") D DIK^ACDFMC W "."
S ACDSIEN("TPR")=$O(^ACDSERV("C","TPR",0))
I ACDSIEN("TPR") S DIK="^ACDSERV(",DA=ACDSIEN("TPR") D DIK^ACDFMC W "."
S ACDSIEN("OTH")=$O(^ACDSERV("C","OTH",0))
Q
;
LOCATION ; DELETE CDMIS LOCATION SCHOOL-*
W !!,"Now converting your CDMIS LOCATION file."
; school-pre-headstart
S ACDLIEN("11")=$O(^ACDLOT("C","11",0))
I ACDLIEN("11") S DIK="^ACDLOT(",DA=ACDLIEN("11") D DIK^ACDFMC W "."
; school-primary
S ACDLIEN("12")=$O(^ACDLOT("C","12",0))
I ACDLIEN("12") S DIK="^ACDLOT(",DA=ACDLIEN("12") D DIK^ACDFMC W "."
; school-secondary
S ACDLIEN("13")=$O(^ACDLOT("C","13",0))
I ACDLIEN("13") S DIK="^ACDLOT(",DA=ACDLIEN("13") D DIK^ACDFMC W "."
; school-post secondary
S ACDLIEN("14")=$O(^ACDLOT("C","14",0))
I ACDLIEN("14") S DIK="^ACDLOT(",DA=ACDLIEN("14") D DIK^ACDFMC W "."
; school
S ACDLIEN("1")=$O(^ACDLOT("C","1",0))
Q
;
COMPONEN ; DELETE CDMIS COMPONENETS LARGE, SMALL, & SPECL DROP IN
W !!,"Now converting your CDMIS COMPONENT file."
S ACDCIEN("LARGE DROP IN")=$O(^ACDCOMP("B","LARGE DROP IN",0))
I ACDCIEN("LARGE DROP IN") S DIK="^ACDCOMP(",DA=ACDCIEN("LARGE DROP IN") D DIK^ACDFMC W "."
S ACDCIEN("SMALL DROP IN")=$O(^ACDCOMP("B","SMALL DROP IN",0))
I ACDCIEN("SMALL DROP IN") S DIK="^ACDCOMP(",DA=ACDCIEN("SMALL DROP IN") D DIK^ACDFMC W "."
S ACDCIEN("SPECL DROP IN")=$O(^ACDCOMP("B","SPECL DROP IN",0))
I ACDCIEN("SPECL DROP IN") S DIK="^ACDCOMP(",DA=ACDCIEN("SPECL DROP IN") D DIK^ACDFMC W "."
S ACDCIEN("DROP IN CENTER")=$O(^ACDCOMP("B","DROP IN CENTER",0))
Q
;
REPOINT ; REPOINT DATA FILES
W !!,"Now repointing files that point to the CDMIS COMPONENT file."
S ACDGBL="^ACDIIF(",ACDFP="15;16,17;18,101;21"
D REPOINT2 ; repoint init/info/fu
S ACDGBL="^ACDPD(",ACDFP="1;2"
D REPOINT2 ; repoint prevention
S ACDGBL="^ACDTDC(",ACDFP="12;13,14;15"
D REPOINT2 ; repoint trans/disc/close
S ACDGBL="^ACDVIS(",ACDFP="1;2"
D REPOINT2 ; repoint visit
S ACDGBL="^ACDPAT(",ACDFP=".03;3"
D REPOINT2 ; repoint client category
S ACDGBL="^ACDINTV(",ACDFP="10;10,11;11"
D REPOINT2 ; repoint interventions
W !!,"Now repointing files that point to the CDMIS SERVICE file."
S ACDRIEN=0
F S ACDRIEN=$O(^ACDCS(ACDRIEN)) Q:ACDRIEN'=+ACDRIEN S X=$G(^ACDCS(ACDRIEN,0)),X=$P(X,U,3) D D:ACDHIT REPCS
. S ACDHIT=0
. I X=ACDLIEN("11") S ACDHIT=1 Q
. I X=ACDLIEN("12") S ACDHIT=1 Q
. I X=ACDLIEN("13") S ACDHIT=1 Q
. I X=ACDLIEN("14") S ACDHIT=1 Q
. Q
Q
;
REPOINT2 ; REPOINT SPECIFIC FILE
S ACDRIEN=0
F S ACDRIEN=$O(@(ACDGBL_ACDRIEN_")")) Q:ACDRIEN'=+ACDRIEN S ACDNODE0=$G(^(ACDRIEN,0)) D
. Q:ACDNODE0=""
. F ACDY=1:1 S X=$P(ACDFP,",",ACDY) Q:X="" D
.. S F=$P(X,";"),P=$P(X,";",2)
.. S X=$P(ACDNODE0,U,P) D D:ACDHIT REPF
... S ACDHIT=0
... I X=ACDCIEN("LARGE DROP IN") S ACDHIT=1 Q
... I X=ACDCIEN("SMALL DROP IN") S ACDHIT=1 Q
... I X=ACDCIEN("SPECL DROP IN") S ACDHIT=1 Q
... Q
.. Q
. Q
K F,P
Q
;
REPF ; REPOINT FIELD
S DIE=ACDGBL,DA=ACDRIEN,DR=F_"////"_ACDCIEN("DROP IN CENTER")
D DIE^ACDFMC
W "."
Q
;
REPCS ; REPOINT CDMIS CLIENT SVCS
S DIE="^ACDCS(",DA=ACDRIEN,DR="2////"_ACDLIEN("1")
D DIE^ACDFMC
W "."
Q
;
TOBACCO ; DELETE TOBACCO FROM DRUGS USED AND SET NEW FIELD
W !!,"Now converting tobacco use to new field."
S ACDTOB1=$O(^ACDDRUG("B","TOBACCO (SMOKING)",0))
S ACDTOB2=$O(^ACDDRUG("B","TOBACCO (SMOKELESS)",0))
I 'ACDTOB1!('ACDTOB2) W !!,"Cannot locate TOBACCO entries in CDMIS DRUG file. No conversion necessary.",! Q
S ACDGBL="^ACDIIF("
D TOBACCO2 ; fix init/info/fu
S ACDGBL="^ACDTDC("
D TOBACCO2 ; fix trans/disc/close
F Y=ACDTOB1,ACDTOB2 S DIK="^ACDDRUG(",DA=Y D ^DIK
Q
;
TOBACCO2 ; FIX ONE FILE
S ACDRIEN=0
F S ACDRIEN=$O(@(ACDGBL_ACDRIEN_")")) Q:ACDRIEN'=+ACDRIEN S ACDNODE0=$G(^(ACDRIEN,0)) D
. Q:ACDNODE0=""
. K ACDTOB
. S ACDMIEN=0
. ; drug multiple
. F S ACDMIEN=$O(@(ACDGBL_ACDRIEN_",2,"_ACDMIEN_")")) Q:ACDMIEN'=+ACDMIEN S X=+^(ACDMIEN,0) D
.. I X'=ACDTOB1,X'=ACDTOB2 Q ; quit if not tobacco
.. S ACDTOB(X)="" ; save type of tobacco
.. S DIK=ACDGBL_ACDRIEN_",2,",DA(1)=ACDRIEN,DA=ACDMIEN D ^DIK
.. Q
. Q:'$D(ACDTOB) ; no tobacco use for entry
. S Y=$O(ACDTOB(0)) ; get type used
. S ACDTOB=$S(Y=ACDTOB1:1,1:2)
. S X=0
. F Y=ACDTOB1,ACDTOB2 S X=X+$D(ACDTOB(Y))
. S:X>1 ACDTOB=3 ; uses both kinds
. S DIE=ACDGBL,DA=ACDRIEN,DR="30////"_ACDTOB
. D DIE^ACDFMC
. W "."
. Q
Q
;
PROBS ; DELETE SELECTED PROBLEMS FROM APPROPRIATE FILES
W !!,"Now converting CDMIS PROBLEM file."
S ACDPIEN=$O(^ACDPROB("C",51,0))
I 'ACDPIEN W !!,"Cannot find PREVIOUS TREATMENT in CDMIS PROBLEM file. No conversion necessary.",! Q
S ACDGBL="^ACDIIF(",ACDNODE=3
D PROBSDEL ; fix init/info/fu
S ACDGBL="^ACDTDC(",ACDNODE=3
D PROBSDEL ; fix trans/disc/close
S ACDGBL="^ACDINTV(",ACDNODE=1
D PROBSDEL ; fix interventions
S DIK="^ACDPROB(",DA=ACDPIEN D ^DIK
Q
;
PROBSDEL ; DELETE ENTRIES FROM FILE
S ACDRIEN=0
F S ACDRIEN=$O(@(ACDGBL_ACDRIEN_")")) Q:ACDRIEN'=+ACDRIEN D
. S ACDMIEN=0
. F S ACDMIEN=$O(@(ACDGBL_ACDRIEN_","_ACDNODE_","_ACDMIEN_")")) Q:ACDMIEN'=+ACDMIEN S Y=+^(ACDMIEN,0) D
.. Q:Y'=ACDPIEN ; not previous treatment
.. S DIK=ACDGBL_ACDRIEN_","_ACDNODE_",",DA(1)=ACDRIEN,DA=ACDMIEN D ^DIK
.. Q
. Q
Q
;
GBLKILL ; KILL GBLS TO BE RESTORED, INFORM OPERATOR
W !!,"Selected file globals will now be killed. You must now",!
W "restore the globals from acd_0410.g",!!
K ^ACDDRUG,^ACDLOT,^ACDSERV,^ACDPROB ; SAC EXEMPTION (2.3.2.3 Killing of unsubscripted globals is prohibited)
Q
;
EOJ ;
K ACDCIEN,ACDLIEN,ACDSIEN,ACDNODE,ACDPIEN,ACDRIEN,ACDY
K ACDFP,ACDGBL,ACDHIT,ACDMIEN,ACDN11,ACDNODE0,ACDPGM,ACDTOB1,ACDTOB2
Q
;
;
FILE200 ; CONVERT FILE 6 POINTERS TO FILE 200 POINTERS
D ^ACD4P1PB
Q
ACD4P1P ;IHS/ADC/EDE/KML - POST-INIT CONVERSIONS FOR V4.1;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;
START ;
+1 WRITE !!,"Beginning the post-init routine ",$TEXT(+0)
+2 WRITE !!,"Installing Protocols..."
DO ^ACDONIT
+3 WRITE !!,"Installing List templates..."
DO ^ACDL
+4 IF $DATA(^TMP("ACD",$JOB,"VIRGIN INSTALL"))
WRITE !!,"Virgin install so post-init not necessary.",!
KILL ^TMP("ACD",$JOB)
QUIT
+5 IF '$GET(DUZ)!($GET(DUZ(0))'["@")
WRITE !!,"Either DUZ is not set or you do not have programmer access. I don't",!,"know how you got here but I cannot run this post-int routine.",!!
QUIT
+6 ; kill most program data
DO PGMFIX
+7 ; kill CDMIS VISIT xrefs
DO VXREFS
+8 ; convert CDMIS SERVICE file
DO SERVICE
+9 ; convert CDMIS LOCATION file
DO LOCATION
+10 ; convert CDMIS COMPONENT file
DO COMPONEN
+11 ; repoint data files
DO REPOINT
+12 ; fix tobacco debacle
DO TOBACCO
+13 ; delete problems
DO PROBS
+14 ; convert file 6 ptrs to file 200 ptrs
DO FILE200
+15 ; kill file gbls to be restored
DO GBLKILL
+16 DO EOJ
+17 QUIT
+18 ;
PGMFIX ; DELETE PROGRAM DATA
+1 SET ACDPGM=0
+2 FOR
SET ACDPGM=$ORDER(^ACDF5PI(ACDPGM))
IF 'ACDPGM
QUIT
Begin DoDot:1
+3 SET ACDN11=$GET(^ACDF5PI(ACDPGM,11))
+4 SET DIK="^ACDF5PI("
SET DA=ACDPGM
+5 DO DIK^ACDFMC
+6 SET DIC="^ACDF5PI("
SET X="`"_ACDPGM
SET DIC(0)="LQ"
SET DLAYGO=9002173
+7 DO DIC^ACDFMC
+8 IF ACDN11=""
QUIT
+9 SET ^ACDF5PI(ACDPGM,11)=ACDN11
+10 QUIT
End DoDot:1
+11 QUIT
+12 ;
VXREFS ; KILL CDMIS VISIT XREFS
+1 KILL ^ACDVIS("E")
+2 KILL ^ACDVIS("F")
+3 KILL ^ACDVIS("G")
+4 KILL ^ACDVIS("H")
+5 QUIT
+6 ;
SERVICE ; DELETE CDMIS SERVICE TP AND TPR
+1 WRITE !!,"Now converting your CDMIS SERVICE file."
+2 SET ACDSIEN("TP")=$ORDER(^ACDSERV("C","TP",0))
+3 IF ACDSIEN("TP")
SET DIK="^ACDSERV("
SET DA=ACDSIEN("TP")
DO DIK^ACDFMC
WRITE "."
+4 SET ACDSIEN("TPR")=$ORDER(^ACDSERV("C","TPR",0))
+5 IF ACDSIEN("TPR")
SET DIK="^ACDSERV("
SET DA=ACDSIEN("TPR")
DO DIK^ACDFMC
WRITE "."
+6 SET ACDSIEN("OTH")=$ORDER(^ACDSERV("C","OTH",0))
+7 QUIT
+8 ;
LOCATION ; DELETE CDMIS LOCATION SCHOOL-*
+1 WRITE !!,"Now converting your CDMIS LOCATION file."
+2 ; school-pre-headstart
+3 SET ACDLIEN("11")=$ORDER(^ACDLOT("C","11",0))
+4 IF ACDLIEN("11")
SET DIK="^ACDLOT("
SET DA=ACDLIEN("11")
DO DIK^ACDFMC
WRITE "."
+5 ; school-primary
+6 SET ACDLIEN("12")=$ORDER(^ACDLOT("C","12",0))
+7 IF ACDLIEN("12")
SET DIK="^ACDLOT("
SET DA=ACDLIEN("12")
DO DIK^ACDFMC
WRITE "."
+8 ; school-secondary
+9 SET ACDLIEN("13")=$ORDER(^ACDLOT("C","13",0))
+10 IF ACDLIEN("13")
SET DIK="^ACDLOT("
SET DA=ACDLIEN("13")
DO DIK^ACDFMC
WRITE "."
+11 ; school-post secondary
+12 SET ACDLIEN("14")=$ORDER(^ACDLOT("C","14",0))
+13 IF ACDLIEN("14")
SET DIK="^ACDLOT("
SET DA=ACDLIEN("14")
DO DIK^ACDFMC
WRITE "."
+14 ; school
+15 SET ACDLIEN("1")=$ORDER(^ACDLOT("C","1",0))
+16 QUIT
+17 ;
COMPONEN ; DELETE CDMIS COMPONENETS LARGE, SMALL, & SPECL DROP IN
+1 WRITE !!,"Now converting your CDMIS COMPONENT file."
+2 SET ACDCIEN("LARGE DROP IN")=$ORDER(^ACDCOMP("B","LARGE DROP IN",0))
+3 IF ACDCIEN("LARGE DROP IN")
SET DIK="^ACDCOMP("
SET DA=ACDCIEN("LARGE DROP IN")
DO DIK^ACDFMC
WRITE "."
+4 SET ACDCIEN("SMALL DROP IN")=$ORDER(^ACDCOMP("B","SMALL DROP IN",0))
+5 IF ACDCIEN("SMALL DROP IN")
SET DIK="^ACDCOMP("
SET DA=ACDCIEN("SMALL DROP IN")
DO DIK^ACDFMC
WRITE "."
+6 SET ACDCIEN("SPECL DROP IN")=$ORDER(^ACDCOMP("B","SPECL DROP IN",0))
+7 IF ACDCIEN("SPECL DROP IN")
SET DIK="^ACDCOMP("
SET DA=ACDCIEN("SPECL DROP IN")
DO DIK^ACDFMC
WRITE "."
+8 SET ACDCIEN("DROP IN CENTER")=$ORDER(^ACDCOMP("B","DROP IN CENTER",0))
+9 QUIT
+10 ;
REPOINT ; REPOINT DATA FILES
+1 WRITE !!,"Now repointing files that point to the CDMIS COMPONENT file."
+2 SET ACDGBL="^ACDIIF("
SET ACDFP="15;16,17;18,101;21"
+3 ; repoint init/info/fu
DO REPOINT2
+4 SET ACDGBL="^ACDPD("
SET ACDFP="1;2"
+5 ; repoint prevention
DO REPOINT2
+6 SET ACDGBL="^ACDTDC("
SET ACDFP="12;13,14;15"
+7 ; repoint trans/disc/close
DO REPOINT2
+8 SET ACDGBL="^ACDVIS("
SET ACDFP="1;2"
+9 ; repoint visit
DO REPOINT2
+10 SET ACDGBL="^ACDPAT("
SET ACDFP=".03;3"
+11 ; repoint client category
DO REPOINT2
+12 SET ACDGBL="^ACDINTV("
SET ACDFP="10;10,11;11"
+13 ; repoint interventions
DO REPOINT2
+14 WRITE !!,"Now repointing files that point to the CDMIS SERVICE file."
+15 SET ACDRIEN=0
+16 FOR
SET ACDRIEN=$ORDER(^ACDCS(ACDRIEN))
IF ACDRIEN'=+ACDRIEN
QUIT
SET X=$GET(^ACDCS(ACDRIEN,0))
SET X=$PIECE(X,U,3)
Begin DoDot:1
+17 SET ACDHIT=0
+18 IF X=ACDLIEN("11")
SET ACDHIT=1
QUIT
+19 IF X=ACDLIEN("12")
SET ACDHIT=1
QUIT
+20 IF X=ACDLIEN("13")
SET ACDHIT=1
QUIT
+21 IF X=ACDLIEN("14")
SET ACDHIT=1
QUIT
+22 QUIT
End DoDot:1
IF ACDHIT
DO REPCS
+23 QUIT
+24 ;
REPOINT2 ; REPOINT SPECIFIC FILE
+1 SET ACDRIEN=0
+2 FOR
SET ACDRIEN=$ORDER(@(ACDGBL_ACDRIEN_")"))
IF ACDRIEN'=+ACDRIEN
QUIT
SET ACDNODE0=$GET(^(ACDRIEN,0))
Begin DoDot:1
+3 IF ACDNODE0=""
QUIT
+4 FOR ACDY=1:1
SET X=$PIECE(ACDFP,",",ACDY)
IF X=""
QUIT
Begin DoDot:2
+5 SET F=$PIECE(X,";")
SET P=$PIECE(X,";",2)
+6 SET X=$PIECE(ACDNODE0,U,P)
Begin DoDot:3
+7 SET ACDHIT=0
+8 IF X=ACDCIEN("LARGE DROP IN")
SET ACDHIT=1
QUIT
+9 IF X=ACDCIEN("SMALL DROP IN")
SET ACDHIT=1
QUIT
+10 IF X=ACDCIEN("SPECL DROP IN")
SET ACDHIT=1
QUIT
+11 QUIT
End DoDot:3
IF ACDHIT
DO REPF
+12 QUIT
End DoDot:2
+13 QUIT
End DoDot:1
+14 KILL F,P
+15 QUIT
+16 ;
REPF ; REPOINT FIELD
+1 SET DIE=ACDGBL
SET DA=ACDRIEN
SET DR=F_"////"_ACDCIEN("DROP IN CENTER")
+2 DO DIE^ACDFMC
+3 WRITE "."
+4 QUIT
+5 ;
REPCS ; REPOINT CDMIS CLIENT SVCS
+1 SET DIE="^ACDCS("
SET DA=ACDRIEN
SET DR="2////"_ACDLIEN("1")
+2 DO DIE^ACDFMC
+3 WRITE "."
+4 QUIT
+5 ;
TOBACCO ; DELETE TOBACCO FROM DRUGS USED AND SET NEW FIELD
+1 WRITE !!,"Now converting tobacco use to new field."
+2 SET ACDTOB1=$ORDER(^ACDDRUG("B","TOBACCO (SMOKING)",0))
+3 SET ACDTOB2=$ORDER(^ACDDRUG("B","TOBACCO (SMOKELESS)",0))
+4 IF 'ACDTOB1!('ACDTOB2)
WRITE !!,"Cannot locate TOBACCO entries in CDMIS DRUG file. No conversion necessary.",!
QUIT
+5 SET ACDGBL="^ACDIIF("
+6 ; fix init/info/fu
DO TOBACCO2
+7 SET ACDGBL="^ACDTDC("
+8 ; fix trans/disc/close
DO TOBACCO2
+9 FOR Y=ACDTOB1,ACDTOB2
SET DIK="^ACDDRUG("
SET DA=Y
DO ^DIK
+10 QUIT
+11 ;
TOBACCO2 ; FIX ONE FILE
+1 SET ACDRIEN=0
+2 FOR
SET ACDRIEN=$ORDER(@(ACDGBL_ACDRIEN_")"))
IF ACDRIEN'=+ACDRIEN
QUIT
SET ACDNODE0=$GET(^(ACDRIEN,0))
Begin DoDot:1
+3 IF ACDNODE0=""
QUIT
+4 KILL ACDTOB
+5 SET ACDMIEN=0
+6 ; drug multiple
+7 FOR
SET ACDMIEN=$ORDER(@(ACDGBL_ACDRIEN_",2,"_ACDMIEN_")"))
IF ACDMIEN'=+ACDMIEN
QUIT
SET X=+^(ACDMIEN,0)
Begin DoDot:2
+8 ; quit if not tobacco
IF X'=ACDTOB1
IF X'=ACDTOB2
QUIT
+9 ; save type of tobacco
SET ACDTOB(X)=""
+10 SET DIK=ACDGBL_ACDRIEN_",2,"
SET DA(1)=ACDRIEN
SET DA=ACDMIEN
DO ^DIK
+11 QUIT
End DoDot:2
+12 ; no tobacco use for entry
IF '$DATA(ACDTOB)
QUIT
+13 ; get type used
SET Y=$ORDER(ACDTOB(0))
+14 SET ACDTOB=$SELECT(Y=ACDTOB1:1,1:2)
+15 SET X=0
+16 FOR Y=ACDTOB1,ACDTOB2
SET X=X+$DATA(ACDTOB(Y))
+17 ; uses both kinds
IF X>1
SET ACDTOB=3
+18 SET DIE=ACDGBL
SET DA=ACDRIEN
SET DR="30////"_ACDTOB
+19 DO DIE^ACDFMC
+20 WRITE "."
+21 QUIT
End DoDot:1
+22 QUIT
+23 ;
PROBS ; DELETE SELECTED PROBLEMS FROM APPROPRIATE FILES
+1 WRITE !!,"Now converting CDMIS PROBLEM file."
+2 SET ACDPIEN=$ORDER(^ACDPROB("C",51,0))
+3 IF 'ACDPIEN
WRITE !!,"Cannot find PREVIOUS TREATMENT in CDMIS PROBLEM file. No conversion necessary.",!
QUIT
+4 SET ACDGBL="^ACDIIF("
SET ACDNODE=3
+5 ; fix init/info/fu
DO PROBSDEL
+6 SET ACDGBL="^ACDTDC("
SET ACDNODE=3
+7 ; fix trans/disc/close
DO PROBSDEL
+8 SET ACDGBL="^ACDINTV("
SET ACDNODE=1
+9 ; fix interventions
DO PROBSDEL
+10 SET DIK="^ACDPROB("
SET DA=ACDPIEN
DO ^DIK
+11 QUIT
+12 ;
PROBSDEL ; DELETE ENTRIES FROM FILE
+1 SET ACDRIEN=0
+2 FOR
SET ACDRIEN=$ORDER(@(ACDGBL_ACDRIEN_")"))
IF ACDRIEN'=+ACDRIEN
QUIT
Begin DoDot:1
+3 SET ACDMIEN=0
+4 FOR
SET ACDMIEN=$ORDER(@(ACDGBL_ACDRIEN_","_ACDNODE_","_ACDMIEN_")"))
IF ACDMIEN'=+ACDMIEN
QUIT
SET Y=+^(ACDMIEN,0)
Begin DoDot:2
+5 ; not previous treatment
IF Y'=ACDPIEN
QUIT
+6 SET DIK=ACDGBL_ACDRIEN_","_ACDNODE_","
SET DA(1)=ACDRIEN
SET DA=ACDMIEN
DO ^DIK
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;
GBLKILL ; KILL GBLS TO BE RESTORED, INFORM OPERATOR
+1 WRITE !!,"Selected file globals will now be killed. You must now",!
+2 WRITE "restore the globals from acd_0410.g",!!
+3 ; SAC EXEMPTION (2.3.2.3 Killing of unsubscripted globals is prohibited)
KILL ^ACDDRUG,^ACDLOT,^ACDSERV,^ACDPROB
+4 QUIT
+5 ;
EOJ ;
+1 KILL ACDCIEN,ACDLIEN,ACDSIEN,ACDNODE,ACDPIEN,ACDRIEN,ACDY
+2 KILL ACDFP,ACDGBL,ACDHIT,ACDMIEN,ACDN11,ACDNODE0,ACDPGM,ACDTOB1,ACDTOB2
+3 QUIT
+4 ;
+5 ;
FILE200 ; CONVERT FILE 6 POINTERS TO FILE 200 POINTERS
+1 DO ^ACD4P1PB
+2 QUIT
