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 ---[H[J[2J[HQAC5PRE 859 printed Dec 13, 2024@02:25:24 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
