QAC5PRE.m

QAC5PRE ;WCIOFO/ERC-Change wording of Issue Code TI05 ;11/17/97

 ;;2.0;Patient Representative;**5**;07/25/1995

 ; This routine will change the wording of Issue Code TI05.

 ; It will also add an additional Discipline to file 745.5

 ; The routine will be run as a pre-install.

 ;

ISS ;issue code wording

 N QACISNUM

 S QACISNUM=0

 S QACISNUM=$O(^QA(745.2,"B","TI05",QACISNUM))

 I $G(QACISNUM)]"" D

 . S $P(^QA(745.2,QACISNUM,0),U,3)="Delay in Scheduling Appt Outside Medical Center"

 . Q

DISC ;add discipline Extended Care to 745.5 and Service/Discipline to 745.55

 S DIC="^QA(745.5,"

 S X="EX"

 S DIC(0)="L"

 D ^DIC K DIC

 S $P(^QA(745.5,12,0),U,2)="Extended Care"

 S (DIC,DLAYGO)="^QA(745.55,",DIC(0)="L"

 S DIC("DR")=".01///EXTENDED CARE"

 D ^DIC

 S DIE=DIC,DA=+Y,DR="1///^S X=""EX"";2///^S X=12"

 D ^DIE

 K DIC,DIE,DLAYGO,DA,DR

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---QAC5PRE   859     printed  Apr 09, 2024@21:27:21                                                                                                                                                                                                      Page 2

QAC5PRE   ;WCIOFO/ERC-Change wording of Issue Code TI05 ;11/17/97

 +1       ;;2.0;Patient Representative;**5**;07/25/1995

 +2       ; This routine will change the wording of Issue Code TI05.

 +3       ; It will also add an additional Discipline to file 745.5

 +4       ; The routine will be run as a pre-install.

 +5       ;

ISS       ;issue code wording

 +1        NEW QACISNUM

 +2        SET QACISNUM=0

 +3        SET QACISNUM=$ORDER(^QA(745.2,"B","TI05",QACISNUM))

 +4        IF $GET(QACISNUM)]""

               Begin DoDot:1

 +5                SET $PIECE(^QA(745.2,QACISNUM,0),U,3)="Delay in Scheduling Appt Outside Medical Center"

 +6                QUIT 

               End DoDot:1

DISC      ;add discipline Extended Care to 745.5 and Service/Discipline to 745.55

 +1        SET DIC="^QA(745.5,"

 +2        SET X="EX"

 +3        SET DIC(0)="L"

 +4        DO ^DIC

           KILL DIC

 +5        SET $PIECE(^QA(745.5,12,0),U,2)="Extended Care"

 +6        SET (DIC,DLAYGO)="^QA(745.55,"

           SET DIC(0)="L"

 +7        SET DIC("DR")=".01///EXTENDED CARE"

 +8        DO ^DIC

 +9        SET DIE=DIC

           SET DA=+Y

           SET DR="1///^S X=""EX"";2///^S X=12"

 +10       DO ^DIE

 +11       KILL DIC,DIE,DLAYGO,DA,DR

 +12       QUIT