QAOSCNV2 ;HISC/DAD-RENUMBER SEVERITY LEVELS ;11/2/92 14:18
;;3.0;Occurrence Screen;;09/14/1993
S QAOSVR=+$G(^DD(741.8,0,"VR")) G:(QAOSVR'>0)!(QAOSVR'<3) EXIT
W !!,"Converting severity level numbers from 1-4 to 0-3"
W !,"-------------------------------------------------",!
F QAOSSNUM=0:0 S QAOSSNUM=$O(^QA(741.8,"B",QAOSSNUM)) Q:QAOSSNUM'>0 F QAOSD0=0:0 S QAOSD0=$O(^QA(741.8,"B",QAOSSNUM,QAOSD0)) Q:QAOSD0'>0 D
. S X=$G(^QA(741.8,QAOSD0,0)),QAOSEVER=$P(X,"^"),QAOSTEXT=$P(X,"^",2)
. Q:(QAOSEVER<1)!(QAOSEVER>4)
. S QAQADICT=741.8,QAQAFLD=.01,X=QAOSEVER,(DA,D0)=QAOSD0
. D ENKILL^QAQAXREF
. S QAOSEVER=QAOSEVER-1
. S $P(^QA(741.8,QAOSD0,0),"^")=QAOSEVER
. S QAQADICT=741.8,QAQAFLD=.01,X=QAOSEVER,(DA,D0)=QAOSD0
. D ENSET^QAQAXREF
. W !?5,QAOSEVER+1," => ",QAOSEVER," - ",QAOSTEXT
. Q
EXIT K D0,DA,DIE,DR,QAOSD0,QAOSEVER,QAOSSNUM,QAOSTEXT,QAOSVR,QAQADICT,QAQAFLD,X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOSCNV2 905 printed Nov 22, 2024@17:31:17 Page 2
QAOSCNV2 ;HISC/DAD-RENUMBER SEVERITY LEVELS ;11/2/92 14:18
+1 ;;3.0;Occurrence Screen;;09/14/1993
+2 SET QAOSVR=+$GET(^DD(741.8,0,"VR"))
if (QAOSVR'>0)!(QAOSVR'<3)
GOTO EXIT
+3 WRITE !!,"Converting severity level numbers from 1-4 to 0-3"
+4 WRITE !,"-------------------------------------------------",!
+5 FOR QAOSSNUM=0:0
SET QAOSSNUM=$ORDER(^QA(741.8,"B",QAOSSNUM))
if QAOSSNUM'>0
QUIT
FOR QAOSD0=0:0
SET QAOSD0=$ORDER(^QA(741.8,"B",QAOSSNUM,QAOSD0))
if QAOSD0'>0
QUIT
Begin DoDot:1
+6 SET X=$GET(^QA(741.8,QAOSD0,0))
SET QAOSEVER=$PIECE(X,"^")
SET QAOSTEXT=$PIECE(X,"^",2)
+7 if (QAOSEVER<1)!(QAOSEVER>4)
QUIT
+8 SET QAQADICT=741.8
SET QAQAFLD=.01
SET X=QAOSEVER
SET (DA,D0)=QAOSD0
+9 DO ENKILL^QAQAXREF
+10 SET QAOSEVER=QAOSEVER-1
+11 SET $PIECE(^QA(741.8,QAOSD0,0),"^")=QAOSEVER
+12 SET QAQADICT=741.8
SET QAQAFLD=.01
SET X=QAOSEVER
SET (DA,D0)=QAOSD0
+13 DO ENSET^QAQAXREF
+14 WRITE !?5,QAOSEVER+1," => ",QAOSEVER," - ",QAOSTEXT
+15 QUIT
End DoDot:1
EXIT KILL D0,DA,DIE,DR,QAOSD0,QAOSEVER,QAOSSNUM,QAOSTEXT,QAOSVR,QAQADICT,QAQAFLD,X
+1 QUIT
