QAOSCNV8 ;HISC/DAD-CONVERT REASONS FOR REFERRAL ;9/9/93 13:52
;;3.0;Occurrence Screen;;09/14/1993
W !!,"Converting text of reasons for referral"
W !,"---------------------------------------"
I $O(^QA(741.1,0))'>0,$O(^QA(741.4,0)) D Q
. S DIU="^QA(741.4,",DIU(0)="DT" D EN^DIU2
. Q
K ^TMP($J,"QAOSCNV8") S QAOCOUNT=0
F QAOSLINE=3:3 S QAOSDATA=$P($T(REFER+QAOSLINE),";;",2) Q:QAOSDATA="" D
. S QAOCOUNT=QAOCOUNT+1
. S ^TMP($J,"QAOSCNV8",QAOCOUNT)=QAOSDATA
. S ^TMP($J,"QAOSCNV8",QAOCOUNT,"S")=$P($T(REFER+QAOSLINE+1),";;",2)
. S ^TMP($J,"QAOSCNV8",QAOCOUNT,"L")=$P($T(REFER+QAOSLINE+2),";;",2)
. Q
D ^QAOSCNV9
F QAOSLINE=1:1:QAOCOUNT D LOOP
K DA,DIC,DIE,DINUM,DLAYGO,DO,DR,QAOCOUNT,QAOFOUND,QAOLDNEW,QAOSD0
K QAOSDATA,QAOSHORT,QAOSLINE,QAOSLONG,QAOSREAS,QAOSSCRN,QAOSTEXT,X,Y
K ^TMP($J,"QAOSCNV8")
Q
LOOP ;
S QAOSDATA=^TMP($J,"QAOSCNV8",QAOSLINE),QAOSSCRN=$P(QAOSDATA,"^")
S QAOSREAS("OLD")=$P(QAOSDATA,"^",2),QAOSREAS("NEW")=$P(QAOSDATA,"^",3)
S QAOSTEXT("SHORT")=^TMP($J,"QAOSCNV8",QAOSLINE,"S")
S QAOSTEXT("LONG")=^TMP($J,"QAOSCNV8",QAOSLINE,"L")
W !!,"Screen: ",QAOSSCRN
I $G(^QA(741.1,QAOSSCRN,0))="" W " *** NOT FOUND ***" Q
W !?5,"Reason for referral code ==> "
W "Old: ",$S(QAOSREAS("OLD")]"":QAOSREAS("OLD"),1:"??")
W ?45,"New: ",QAOSREAS("NEW")
S QAOFOUND=0
F QAOLDNEW="NEW","OLD" D Q:QAOFOUND
. S X=QAOSREAS(QAOLDNEW),QAOSREAS=+X+($A(X,$L(X))/100)
. F QAOSD0=0:0 S QAOSD0=$O(^QA(741.4,"AC",QAOSSCRN,QAOSREAS,QAOSD0)) Q:QAOSD0'>0 D Q:QAOFOUND
.. S QAOSREAS(0)=$P($G(^QA(741.4,QAOSD0,0)),"^") Q:QAOSREAS(0)=""
.. S QAOSLONG=$P($G(^QA(741.4,QAOSD0,1)),"^")
.. S QAOSHORT=$P($G(^QA(741.4,QAOSD0,2)),"^")
.. I QAOSREAS(0)=QAOSREAS("NEW"),QAOSLONG=QAOSTEXT("LONG"),QAOSHORT=QAOSTEXT("SHORT") S QAOFOUND=2 Q
.. I QAOSREAS(0)=QAOSREAS("OLD") S QAOFOUND=1
.. Q
. Q
I 'QAOFOUND D
. K DD,DIC,DINUM,DO
. S DIC="^QA(741.4,",DIC(0)="L",DIC("DR")=""
. S DLAYGO=741.4,X=QAOSREAS("NEW")
. D FILE^DICN S QAOSD0=+Y
. Q
W !?10,"Old text: ",$P($G(^QA(741.4,QAOSD0,2)),"^")
W !?10,"New text: ",QAOSTEXT("SHORT")
Q:QAOFOUND=2
K DA,DIC,DIE,DR
S DIE="^QA(741.4,",DA=QAOSD0
S DR=".01////"_QAOSREAS("NEW")_";2////"_QAOSSCRN
S DR(1,741.4,1)="1////"_QAOSTEXT("LONG")
S DR(1,741.4,2)="3////"_QAOSTEXT("SHORT")
D ^DIE
Q
REFER ;;SCREEN ^ OLD NUMBER ^ NEW NUMBER
;;NEW TEXT (SHORT)
;;NEW TEXT (LONG)
1011 ;;101.1^10^99
;;OTHER
;;OTHER
;;101.1^^10
;;PATIENT NON-COMPLIANCE
;;READMISSION APPEARS TO BE RELATED TO ISSUES OF PATIENT NON-COMPLIANCE
;;101.1^9^9
;;DECUBITI DEHYDRATION OR DRUG TOXICITY
;;PATIENT REHOSPITALIZED FOR DECUBITI DEHYDRATION OR DRUG TOXICITY
;;101.1^8^8
;;FAILURE OF CONTINUING TREATMENT DURING OUTPATIENT PERIOD
;;READMISSION APPEARS TO BE RELATED TO FAILURE OF CONTINUING TREATMENT DURING OUTPATIENT PERIOD
;;101.1^7^7
;;UNEXPECTED EXACERBATION OF ILLNESS
;;READMISSION APPEARS TO BE RELATED TO UNEXPECTED EXACERBATION OF ILLNESS
;;101.1^6^6
;;PATIENT EDUCATION
;;READMISSION APPEARS TO BE RELATED TO PATIENT EDUCATION CONCERNING PROBLEMS TREATED DURING FIRST HOSPITALIZATION
;;101.1^5^5
;;DISCHARGE ORDERS
;;READMISSION APPEARS TO BE RELATED TO SOME ASPECT OF DISCHARGE ORDERS
;;101.1^4^4
;;PRE-EXISTENT UNDIAGNOSED CONDITION
;;READMISSION APPEARS TO BE RELATED TO CONDITION WHICH MAY HAVE EXISTED AT TIME OF FIRST HOSPITALIZATION BUT WAS NOT DIAGNOSED
;;101.1^3^3
;;TIMELINESS OF DISCHARGE
;;READMISSION APPEARS TO BE RELATED TO TIMELINESS OF DISCHARGE
;;101.1^2^2
;;DISCHARGE PLANS MADE DURING PREVIOUS HOSPITALIZATION
;;READMISSION APPEARS TO BE RELATED TO DISCHARGE PLANS MADE DURING PREVIOUS HOSPITALIZATION
;;101.1^1^1
;;COMPLICATION OF TREATMENT DURING PRIOR HOSPITALIZATION
;;READMISSION APPEARS TO BE RELATED TO COMPLICATION OF TREATMENT DURING PRIOR HOSPITALIZATION
102 ;;102^5^99
;;OTHER
;;OTHER
;;102^2^2
;;OUTPATIENT DRUG THERAPY
;;ADMISSION APPEARS TO HAVE BEEN A CONSEQUENCE OF OUTPATIENT DRUG THERAPY
;;102^3^3
;;FOLLOWED TWO OR MORE OUTPATIENT VISITS FOR SAME ACUTE CONDITION
;;ADMISSION FOLLOWED TWO OR MORE OUTPATIENT VISITS FOR SAME ACUTE CONDITION
;;102^4^4
;;ESCALATION OF CARE INAPPROPRIATELY DELAYED
;;ESCALATION OF CARE TO INPATIENT LEVEL APPEARS TO HAVE BEEN INAPPROPRIATELY DELAYED
;;102^^1K
;;OUTPATIENT MANAGEMENT ISSUE: NON-COMPLIANCE AND FAILURE TO OBTAIN PRESCRIBED MEDICATIONS
;;ADMISSION APPEARS TO BE RELATED TO NON-COMPLIANCE AND FAILURE TO OBTAIN PRESCRIBED MEDICATIONS
;;102^1I^1J
;;OUTPATIENT MANAGEMENT ISSUE: FOLLOW-UP OF FINANCIAL OR SOCIAL SUPPORT PROBLEMS
;;ADMISSION APPEARS TO BE RELATED TO OUTPATIENT MANAGEMENT ISSUE: FOLLOW-UP OF FINANCIAL OR SOCIAL SUPPORT PROBLEMS PARTICULARLY FOR PSYCHIATRIC PATIENTS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOSCNV8 4781 printed Nov 22, 2024@17:31:21 Page 2
QAOSCNV8 ;HISC/DAD-CONVERT REASONS FOR REFERRAL ;9/9/93 13:52
+1 ;;3.0;Occurrence Screen;;09/14/1993
+2 WRITE !!,"Converting text of reasons for referral"
+3 WRITE !,"---------------------------------------"
+4 IF $ORDER(^QA(741.1,0))'>0
IF $ORDER(^QA(741.4,0))
Begin DoDot:1
+5 SET DIU="^QA(741.4,"
SET DIU(0)="DT"
DO EN^DIU2
+6 QUIT
End DoDot:1
QUIT
+7 KILL ^TMP($JOB,"QAOSCNV8")
SET QAOCOUNT=0
+8 FOR QAOSLINE=3:3
SET QAOSDATA=$PIECE($TEXT(REFER+QAOSLINE),";;",2)
if QAOSDATA=""
QUIT
Begin DoDot:1
+9 SET QAOCOUNT=QAOCOUNT+1
+10 SET ^TMP($JOB,"QAOSCNV8",QAOCOUNT)=QAOSDATA
+11 SET ^TMP($JOB,"QAOSCNV8",QAOCOUNT,"S")=$PIECE($TEXT(REFER+QAOSLINE+1),";;",2)
+12 SET ^TMP($JOB,"QAOSCNV8",QAOCOUNT,"L")=$PIECE($TEXT(REFER+QAOSLINE+2),";;",2)
+13 QUIT
End DoDot:1
+14 DO ^QAOSCNV9
+15 FOR QAOSLINE=1:1:QAOCOUNT
DO LOOP
+16 KILL DA,DIC,DIE,DINUM,DLAYGO,DO,DR,QAOCOUNT,QAOFOUND,QAOLDNEW,QAOSD0
+17 KILL QAOSDATA,QAOSHORT,QAOSLINE,QAOSLONG,QAOSREAS,QAOSSCRN,QAOSTEXT,X,Y
+18 KILL ^TMP($JOB,"QAOSCNV8")
+19 QUIT
LOOP ;
+1 SET QAOSDATA=^TMP($JOB,"QAOSCNV8",QAOSLINE)
SET QAOSSCRN=$PIECE(QAOSDATA,"^")
+2 SET QAOSREAS("OLD")=$PIECE(QAOSDATA,"^",2)
SET QAOSREAS("NEW")=$PIECE(QAOSDATA,"^",3)
+3 SET QAOSTEXT("SHORT")=^TMP($JOB,"QAOSCNV8",QAOSLINE,"S")
+4 SET QAOSTEXT("LONG")=^TMP($JOB,"QAOSCNV8",QAOSLINE,"L")
+5 WRITE !!,"Screen: ",QAOSSCRN
+6 IF $GET(^QA(741.1,QAOSSCRN,0))=""
WRITE " *** NOT FOUND ***"
QUIT
+7 WRITE !?5,"Reason for referral code ==> "
+8 WRITE "Old: ",$SELECT(QAOSREAS("OLD")]"":QAOSREAS("OLD"),1:"??")
+9 WRITE ?45,"New: ",QAOSREAS("NEW")
+10 SET QAOFOUND=0
+11 FOR QAOLDNEW="NEW","OLD"
Begin DoDot:1
+12 SET X=QAOSREAS(QAOLDNEW)
SET QAOSREAS=+X+($ASCII(X,$LENGTH(X))/100)
+13 FOR QAOSD0=0:0
SET QAOSD0=$ORDER(^QA(741.4,"AC",QAOSSCRN,QAOSREAS,QAOSD0))
if QAOSD0'>0
QUIT
Begin DoDot:2
+14 SET QAOSREAS(0)=$PIECE($GET(^QA(741.4,QAOSD0,0)),"^")
if QAOSREAS(0)=""
QUIT
+15 SET QAOSLONG=$PIECE($GET(^QA(741.4,QAOSD0,1)),"^")
+16 SET QAOSHORT=$PIECE($GET(^QA(741.4,QAOSD0,2)),"^")
+17 IF QAOSREAS(0)=QAOSREAS("NEW")
IF QAOSLONG=QAOSTEXT("LONG")
IF QAOSHORT=QAOSTEXT("SHORT")
SET QAOFOUND=2
QUIT
+18 IF QAOSREAS(0)=QAOSREAS("OLD")
SET QAOFOUND=1
+19 QUIT
End DoDot:2
if QAOFOUND
QUIT
+20 QUIT
End DoDot:1
if QAOFOUND
QUIT
+21 IF 'QAOFOUND
Begin DoDot:1
+22 KILL DD,DIC,DINUM,DO
+23 SET DIC="^QA(741.4,"
SET DIC(0)="L"
SET DIC("DR")=""
+24 SET DLAYGO=741.4
SET X=QAOSREAS("NEW")
+25 DO FILE^DICN
SET QAOSD0=+Y
+26 QUIT
End DoDot:1
+27 WRITE !?10,"Old text: ",$PIECE($GET(^QA(741.4,QAOSD0,2)),"^")
+28 WRITE !?10,"New text: ",QAOSTEXT("SHORT")
+29 if QAOFOUND=2
QUIT
+30 KILL DA,DIC,DIE,DR
+31 SET DIE="^QA(741.4,"
SET DA=QAOSD0
+32 SET DR=".01////"_QAOSREAS("NEW")_";2////"_QAOSSCRN
+33 SET DR(1,741.4,1)="1////"_QAOSTEXT("LONG")
+34 SET DR(1,741.4,2)="3////"_QAOSTEXT("SHORT")
+35 DO ^DIE
+36 QUIT
REFER ;;SCREEN ^ OLD NUMBER ^ NEW NUMBER
+1 ;;NEW TEXT (SHORT)
+2 ;;NEW TEXT (LONG)
1011 ;;101.1^10^99
+1 ;;OTHER
+2 ;;OTHER
+3 ;;101.1^^10
+4 ;;PATIENT NON-COMPLIANCE
+5 ;;READMISSION APPEARS TO BE RELATED TO ISSUES OF PATIENT NON-COMPLIANCE
+6 ;;101.1^9^9
+7 ;;DECUBITI DEHYDRATION OR DRUG TOXICITY
+8 ;;PATIENT REHOSPITALIZED FOR DECUBITI DEHYDRATION OR DRUG TOXICITY
+9 ;;101.1^8^8
+10 ;;FAILURE OF CONTINUING TREATMENT DURING OUTPATIENT PERIOD
+11 ;;READMISSION APPEARS TO BE RELATED TO FAILURE OF CONTINUING TREATMENT DURING OUTPATIENT PERIOD
+12 ;;101.1^7^7
+13 ;;UNEXPECTED EXACERBATION OF ILLNESS
+14 ;;READMISSION APPEARS TO BE RELATED TO UNEXPECTED EXACERBATION OF ILLNESS
+15 ;;101.1^6^6
+16 ;;PATIENT EDUCATION
+17 ;;READMISSION APPEARS TO BE RELATED TO PATIENT EDUCATION CONCERNING PROBLEMS TREATED DURING FIRST HOSPITALIZATION
+18 ;;101.1^5^5
+19 ;;DISCHARGE ORDERS
+20 ;;READMISSION APPEARS TO BE RELATED TO SOME ASPECT OF DISCHARGE ORDERS
+21 ;;101.1^4^4
+22 ;;PRE-EXISTENT UNDIAGNOSED CONDITION
+23 ;;READMISSION APPEARS TO BE RELATED TO CONDITION WHICH MAY HAVE EXISTED AT TIME OF FIRST HOSPITALIZATION BUT WAS NOT DIAGNOSED
+24 ;;101.1^3^3
+25 ;;TIMELINESS OF DISCHARGE
+26 ;;READMISSION APPEARS TO BE RELATED TO TIMELINESS OF DISCHARGE
+27 ;;101.1^2^2
+28 ;;DISCHARGE PLANS MADE DURING PREVIOUS HOSPITALIZATION
+29 ;;READMISSION APPEARS TO BE RELATED TO DISCHARGE PLANS MADE DURING PREVIOUS HOSPITALIZATION
+30 ;;101.1^1^1
+31 ;;COMPLICATION OF TREATMENT DURING PRIOR HOSPITALIZATION
+32 ;;READMISSION APPEARS TO BE RELATED TO COMPLICATION OF TREATMENT DURING PRIOR HOSPITALIZATION
102 ;;102^5^99
+1 ;;OTHER
+2 ;;OTHER
+3 ;;102^2^2
+4 ;;OUTPATIENT DRUG THERAPY
+5 ;;ADMISSION APPEARS TO HAVE BEEN A CONSEQUENCE OF OUTPATIENT DRUG THERAPY
+6 ;;102^3^3
+7 ;;FOLLOWED TWO OR MORE OUTPATIENT VISITS FOR SAME ACUTE CONDITION
+8 ;;ADMISSION FOLLOWED TWO OR MORE OUTPATIENT VISITS FOR SAME ACUTE CONDITION
+9 ;;102^4^4
+10 ;;ESCALATION OF CARE INAPPROPRIATELY DELAYED
+11 ;;ESCALATION OF CARE TO INPATIENT LEVEL APPEARS TO HAVE BEEN INAPPROPRIATELY DELAYED
+12 ;;102^^1K
+13 ;;OUTPATIENT MANAGEMENT ISSUE: NON-COMPLIANCE AND FAILURE TO OBTAIN PRESCRIBED MEDICATIONS
+14 ;;ADMISSION APPEARS TO BE RELATED TO NON-COMPLIANCE AND FAILURE TO OBTAIN PRESCRIBED MEDICATIONS
+15 ;;102^1I^1J
+16 ;;OUTPATIENT MANAGEMENT ISSUE: FOLLOW-UP OF FINANCIAL OR SOCIAL SUPPORT PROBLEMS
+17 ;;ADMISSION APPEARS TO BE RELATED TO OUTPATIENT MANAGEMENT ISSUE: FOLLOW-UP OF FINANCIAL OR SOCIAL SUPPORT PROBLEMS PARTICULARLY FOR PSYCHIATRIC PATIENTS
