ACMPOST1.m

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