ACMPOST1 ; IHS/TUCSON/TMJ - POST INIT #2 ;
;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996
;
;RECALL DATE CONVERSION ROUTINE - CALLED FROM ACMPOST
;
START ;EP - CALLED FROM ACMPOST
I $P(^ACM(40,DUZ(2),0),U,4) W !,"RECALL CONVERSION DONE PREVIOUSLY-NO ACTION TAKEN ON RECALL CONVERSION",!! Q
;
W "It appears the Conversion is NOT done..I will now begin the Recall Date Conversion Process",!
;
D ORGAN,SERVICE,RECALL1,APPTSTAT,RECLDIE,EXIT
Q
;
;
ORGAN ;Converts Resource DFN's Text value to the new Organization field (ORGAN1)
;
;Q
W !!,"Setting the old Resource Ptr TEXT value into Organization Field",!
S ACMDFN=0 F S ACMDFN=$O(^ACM(49,ACMDFN)) Q:ACMDFN'=+ACMDFN I $D(^ACM(49,ACMDFN,0)) D
. ;Convert the Old Resource Pointer Text Value to Organization Text
.W !,"Now Converting the Resource Pointer DFN to Organization Text...",!
.S ACMOLDN=$P(^ACM(49,ACMDFN,0),U,1)
.Q:'ACMOLDN
.S ACMNEWN=$P($G(^ACM(50,ACMOLDN,0)),U,1)
.I ACMNEWN="" S ACMNEWN="UNKNOWN"
.S DA=ACMDFN,DIE="^ACM(49,",DR="3////"_ACMNEWN D ^DIE K DIE
K ACMDFN,ACMOLDN,ACMNEWN Q
;
SERVICE ;Convert Service DFN in new Purpose Field #11 to Actual Text value in CMS Service List Entry File
;
;Q
W !!,"Setting the Old Service Pointer TEXT value in Purpose Field",!!
S ACMDFN=0 F S ACMDFN=$O(^ACM(49,ACMDFN)) Q:ACMDFN'=+ACMDFN I $D(^ACM(49,ACMDFN,0)) D
. ;Convert to Service Pointer to Purpose Free Text
.W !,"Now Converting the Service Pointer to Purpose...",!
.S ACMOLDN=$P(^ACM(49,ACMDFN,"DT"),U,5)
.Q:'ACMOLDN
.S ACMNEWN=$P($G(^ACM(47.1,ACMOLDN,0)),U,1)
.I ACMNEWN="" S ACMNEWN="UNKNOWN"
.S DA=ACMDFN,DIE="^ACM(49,",DR="11////"_ACMNEWN D ^DIE K DIE
K ACMDFN,ACMOLDN,ACMNEWN Q
RECALL1 ;Converts Old .01 Resource to Recall Date (Next Appoint Fld #1 value)
;
;Q
W !!,"Now Converting the old Resource value to new Recall Date...",!!
S ACMDFN=0 F S ACMDFN=$O(^ACM(49,ACMDFN)) Q:ACMDFN'=+ACMDFN I $D(^ACM(49,ACMDFN,"DT")) D
. ;Convert the Resource .01 to Next Appointment Date
.S ACMNEWN=$P($G(^ACM(49,ACMDFN,"DT")),U,1)
.I 'ACMNEWN S ACMNEWN=DT
.S DA=ACMDFN,DIE="^ACM(49,",DR=".01////"_ACMNEWN D ^DIE K DIE
K ACMDFN,ACMNEWN Q
;
APPTSTAT ;Convert Date Last Seen to Appointment Status=Open
;
W !!,"Converting Date Last Seen Fld to Appointment Status=OPEN...",!!
S ACMDFN=0 F S ACMDFN=$O(^ACM(49,ACMDFN)) Q:ACMDFN'=+ACMDFN I $D(^ACM(49,ACMDFN,"DT")) D
.S ACMNEWN=$S($P(^ACM(49,ACMDFN,"DT"),U,2)'="":"O",$P(^ACM(49,ACMDFN,"DT"),U,2)="":"")
.S DA=ACMDFN,DIE="^ACM(49,",DR="2////"_ACMNEWN D ^DIE K DIE
;
K ACMDFN,ACMNEWN Q
;
RECLDIE ;SET FLAG IN CMS PARAMETERS FILE TO INDICATE RECALL DATE CONVERSION HAS BEEN COMPLETED
;
W !!,"I will now set the CMS Parameters Flag to Indicate the Recall Date Conversion process has been completed",!!
S DIE="^ACM(40,",DA=DUZ(2),DR="3.5///1" D ^DIE K DIE,DR,DA,DIC
Q
EXIT ;
W !!,?10,"Conversion Complete ",!
Q
ACMPOST1 ; IHS/TUCSON/TMJ - POST INIT #2 ;
+1 ;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996
+2 ;
+3 ;RECALL DATE CONVERSION ROUTINE - CALLED FROM ACMPOST
+4 ;
START ;EP - CALLED FROM ACMPOST
+1 IF $PIECE(^ACM(40,DUZ(2),0),U,4)
WRITE !,"RECALL CONVERSION DONE PREVIOUSLY-NO ACTION TAKEN ON RECALL CONVERSION",!!
QUIT
+2 ;
+3 WRITE "It appears the Conversion is NOT done..I will now begin the Recall Date Conversion Process",!
+4 ;
+5 DO ORGAN
DO SERVICE
DO RECALL1
DO APPTSTAT
DO RECLDIE
DO EXIT
+6 QUIT
+7 ;
+8 ;
ORGAN ;Converts Resource DFN's Text value to the new Organization field (ORGAN1)
+1 ;
+2 ;Q
+3 WRITE !!,"Setting the old Resource Ptr TEXT value into Organization Field",!
+4 SET ACMDFN=0
FOR
SET ACMDFN=$ORDER(^ACM(49,ACMDFN))
IF ACMDFN'=+ACMDFN
QUIT
IF $DATA(^ACM(49,ACMDFN,0))
Begin DoDot:1
+5 ;Convert the Old Resource Pointer Text Value to Organization Text
+6 WRITE !,"Now Converting the Resource Pointer DFN to Organization Text...",!
+7 SET ACMOLDN=$PIECE(^ACM(49,ACMDFN,0),U,1)
+8 IF 'ACMOLDN
QUIT
+9 SET ACMNEWN=$PIECE($GET(^ACM(50,ACMOLDN,0)),U,1)
+10 IF ACMNEWN=""
SET ACMNEWN="UNKNOWN"
+11 SET DA=ACMDFN
SET DIE="^ACM(49,"
SET DR="3////"_ACMNEWN
DO ^DIE
KILL DIE
End DoDot:1
+12 KILL ACMDFN,ACMOLDN,ACMNEWN
QUIT
+13 ;
SERVICE ;Convert Service DFN in new Purpose Field #11 to Actual Text value in CMS Service List Entry File
+1 ;
+2 ;Q
+3 WRITE !!,"Setting the Old Service Pointer TEXT value in Purpose Field",!!
+4 SET ACMDFN=0
FOR
SET ACMDFN=$ORDER(^ACM(49,ACMDFN))
IF ACMDFN'=+ACMDFN
QUIT
IF $DATA(^ACM(49,ACMDFN,0))
Begin DoDot:1
+5 ;Convert to Service Pointer to Purpose Free Text
+6 WRITE !,"Now Converting the Service Pointer to Purpose...",!
+7 SET ACMOLDN=$PIECE(^ACM(49,ACMDFN,"DT"),U,5)
+8 IF 'ACMOLDN
QUIT
+9 SET ACMNEWN=$PIECE($GET(^ACM(47.1,ACMOLDN,0)),U,1)
+10 IF ACMNEWN=""
SET ACMNEWN="UNKNOWN"
+11 SET DA=ACMDFN
SET DIE="^ACM(49,"
SET DR="11////"_ACMNEWN
DO ^DIE
KILL DIE
End DoDot:1
+12 KILL ACMDFN,ACMOLDN,ACMNEWN
QUIT
RECALL1 ;Converts Old .01 Resource to Recall Date (Next Appoint Fld #1 value)
+1 ;
+2 ;Q
+3 WRITE !!,"Now Converting the old Resource value to new Recall Date...",!!
+4 SET ACMDFN=0
FOR
SET ACMDFN=$ORDER(^ACM(49,ACMDFN))
IF ACMDFN'=+ACMDFN
QUIT
IF $DATA(^ACM(49,ACMDFN,"DT"))
Begin DoDot:1
+5 ;Convert the Resource .01 to Next Appointment Date
+6 SET ACMNEWN=$PIECE($GET(^ACM(49,ACMDFN,"DT")),U,1)
+7 IF 'ACMNEWN
SET ACMNEWN=DT
+8 SET DA=ACMDFN
SET DIE="^ACM(49,"
SET DR=".01////"_ACMNEWN
DO ^DIE
KILL DIE
End DoDot:1
+9 KILL ACMDFN,ACMNEWN
QUIT
+10 ;
APPTSTAT ;Convert Date Last Seen to Appointment Status=Open
+1 ;
+2 WRITE !!,"Converting Date Last Seen Fld to Appointment Status=OPEN...",!!
+3 SET ACMDFN=0
FOR
SET ACMDFN=$ORDER(^ACM(49,ACMDFN))
IF ACMDFN'=+ACMDFN
QUIT
IF $DATA(^ACM(49,ACMDFN,"DT"))
Begin DoDot:1
+4 SET ACMNEWN=$SELECT($PIECE(^ACM(49,ACMDFN,"DT"),U,2)'="":"O",$PIECE(^ACM(49,ACMDFN,"DT"),U,2)="":"")
+5 SET DA=ACMDFN
SET DIE="^ACM(49,"
SET DR="2////"_ACMNEWN
DO ^DIE
KILL DIE
End DoDot:1
+6 ;
+7 KILL ACMDFN,ACMNEWN
QUIT
+8 ;
RECLDIE ;SET FLAG IN CMS PARAMETERS FILE TO INDICATE RECALL DATE CONVERSION HAS BEEN COMPLETED
+1 ;
+2 WRITE !!,"I will now set the CMS Parameters Flag to Indicate the Recall Date Conversion process has been completed",!!
+3 SET DIE="^ACM(40,"
SET DA=DUZ(2)
SET DR="3.5///1"
DO ^DIE
KILL DIE,DR,DA,DIC
+4 QUIT
EXIT ;
+1 WRITE !!,?10,"Conversion Complete ",!
+2 QUIT
