QAC3PRE ;WCIOFO/ERC-Patch 3 Preinstall ;8/18/97
;;2.0;Patient Representative;**3**;07/25/95
; Routine will check the 8 Issue Codes whose names are changed
; with this patch and change the name now, so that the KIDS install
; will not create a second entry.
START ;
N CNT,DIE,EE,QACBAD,QACCDE,QACCODE,QACDAT,QACISS,QACNUM,QACROC,QACTEXT
S QACCODE="CA03^CA05^CC02^CC05^CC06^EL07^TI03^TI04"
S QACTEXT(1)="Patient not Included/Disagree with Decisions about Care"
S QACTEXT(2)="Dissatisfied with Referral Outcome"
S QACTEXT(3)="Not treated with dignity and respect/Perceived rudeness"
S QACTEXT(4)="Staff not listen to patient concerns/Patient feels rushed"
S QACTEXT(5)="Phone calls not returned/answered"
S QACTEXT(6)="VA billing for service/Pharmacy co-payment"
S QACTEXT(7)="Excessive wait at facility for admission"
S QACTEXT(8)="Excessive delay scheduling or rescheduling appt w/i facility"
F CNT=1:1:8 S QACCDE=$P(QACCODE,U,CNT) D
. S EE=0
. S QACNUM=$O(^QA(745.2,"B",QACCDE,EE))
. I $G(QACNUM)>0 S DIE="^QA(745.2,",DR="2///^S X=QACTEXT(CNT)",DA=QACNUM D ^DIE K DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAC3PRE 1110 printed Dec 13, 2024@02:25:23 Page 2
QAC3PRE ;WCIOFO/ERC-Patch 3 Preinstall ;8/18/97
+1 ;;2.0;Patient Representative;**3**;07/25/95
+2 ; Routine will check the 8 Issue Codes whose names are changed
+3 ; with this patch and change the name now, so that the KIDS install
+4 ; will not create a second entry.
START ;
+1 NEW CNT,DIE,EE,QACBAD,QACCDE,QACCODE,QACDAT,QACISS,QACNUM,QACROC,QACTEXT
+2 SET QACCODE="CA03^CA05^CC02^CC05^CC06^EL07^TI03^TI04"
+3 SET QACTEXT(1)="Patient not Included/Disagree with Decisions about Care"
+4 SET QACTEXT(2)="Dissatisfied with Referral Outcome"
+5 SET QACTEXT(3)="Not treated with dignity and respect/Perceived rudeness"
+6 SET QACTEXT(4)="Staff not listen to patient concerns/Patient feels rushed"
+7 SET QACTEXT(5)="Phone calls not returned/answered"
+8 SET QACTEXT(6)="VA billing for service/Pharmacy co-payment"
+9 SET QACTEXT(7)="Excessive wait at facility for admission"
+10 SET QACTEXT(8)="Excessive delay scheduling or rescheduling appt w/i facility"
+11 FOR CNT=1:1:8
SET QACCDE=$PIECE(QACCODE,U,CNT)
Begin DoDot:1
+12 SET EE=0
+13 SET QACNUM=$ORDER(^QA(745.2,"B",QACCDE,EE))
+14 IF $GET(QACNUM)>0
SET DIE="^QA(745.2,"
SET DR="2///^S X=QACTEXT(CNT)"
SET DA=QACNUM
DO ^DIE
KILL DIE
End DoDot:1
+15 QUIT
