QAOSCNVA ;HISC/DDA-CONVERT VALADATED/COMFIRMED SYS/EQIP ISSUES ;1/3/94 15:49
;;3.0;Occurrence Screen;**6**;09/14/1993
INFO ; INFORMATION ABOUT THIS CONVERSION PROCESS.
W !!,"This conversion restores previous versions' SYSTEM and EQUIPMENT"
W !,"issues and makes them available for historical reporting via the"
W !,"option 'System/Equipment Problems' [QAOS RPT SYS/MGMT/EQUIP PROB]"
W !!,"As part of the conversion a non-committee place holder,"
W !,"VALIDATED/CONFIRMED, is added to the 'QA OCCURRENCE COMMITTEE'"
W !,"file (#741.97)."
W !!,"The actual conversion can be performed any number of times with"
W !,"no adverse impact on the data. If the conversion is interrupted"
W !,"for any reason, simply run this routine again."
W !,"++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++"
; HAVE USER PRESS RETURN TO CONTINUE
S DIR(0)="E" W ! D ^DIR K DIR
I Y'=1 S CNVMSG="User stopped conversion process." G ERROR
S STARTIME=$P($H,",",2)
W !!,"Starting the conversion..."
ADDCOM W !!,"Adding place holder committee - VALIDATED/CONFIRMED"
W !,"---------------------------------------------------"
K DD,DIC,DINUM,DO
S X="VALIDATED/CONFIRMED"
; IF IT IS ALREADY IN THE FILE, SKIP TO THE CONVERSION
S CNVCOM=$O(^QA(741.97,"B",X,""))
G:CNVCOM>0 LP
S DIC="^QA(741.97,",DIC(0)="EL",DIC("DR")="1///XX",DLAYGO=741.97 D FILE^DICN I Y=-1 S CNVMSG="UNABLE TO ADD 'VALILATED/CONFIRMED' COMMITTEE TO FILE #741.97" G ERROR
S CNVCOM=+Y K DIC,DLAYGO
LP W !,"Done..."
W !!,"Moving VALIDATED/CONFIRMED data to the committee area"
W !,"-----------------------------------------------------"
S (CNT,CNV)=0
D NOW^%DTC S CNVDT=X
D WAIT^DICD
D LOOP
W !,"Done..."
S ENDTIME=$P($H,",",2),%=ENDTIME-STARTIME D S^%DTC
S HOURS=+$E(%,2,3),MINUTES=+$E(%,4,5),SECONDS=+$E(%,6,7)
W !!,"-----------------------------------------------------"
W !,"Total records checked: "_CNT_" Total records modified: "_CNV
W !,"Conversion completed in ",HOURS,"H ",MINUTES,"M ",SECONDS,"S."
EXIT K CNT,CNV,CNVCOM,CNVDT,CNVMSG,COMDA,COMIEN,COMMENTS,COMTTL,DA,DD,DIC,DINUM,DLAYGO,DO,ENDTIME,HOURS,IEN,MINUTES,OKAY,QAQADICT,QAQAFLD,SECONDS,STARTIME,VALDT,VC,X,Y,ZER0
Q
LOOP ; LOOP VIA "AVAL" CROSS REFERENCE. ONLY THOSE RECORDS WITH A VALIDATION DATE ARE CHECKED.
S VALDT=0
F S VALDT=$O(^QA(741,"AVAL",VALDT)) Q:VALDT'>0 S IEN=0 F S IEN=$O(^QA(741,"AVAL",VALDT,IEN)) Q:IEN'>0 S ZER0=$G(^QA(741,IEN,0)) D
.S CNT=CNT+1
.; CONTINUE IF THERE IS ISSUE CODE DATA (VC)
.I +$P(ZER0,"^",20)'=0 D
..S VC=$P(ZER0,"^",20),COMIEN=0,OKAY=1
..; CHECK ALL COMMITTEE ENTRIES. CONTINUE IF NONE HAVE THE SAME ISSUE CODE (VC)
..F S:$D(^QA(741,IEN,"CMTE")) COMIEN=$O(^QA(741,IEN,"CMTE",COMIEN)) Q:COMIEN'>0 I $P($G(^QA(741,IEN,"CMTE",COMIEN,0)),"^",5)=VC S OKAY=0
..; SET HEADER IF NO PREVIOUS COMMITTEE DATA
..I OKAY D
...;SETUP AND STORE COMMITTEE DATA
...I '$D(^QA(741,IEN,"CMTE")) S ^QA(741,IEN,"CMTE",0)="^741.017PA^"
...S COMMENTS=$G(^QA(741,IEN,1))
...S COMDA=$P($G(^QA(741,IEN,"CMTE",0)),"^",3)
...S COMTTL=$P($G(^QA(741,IEN,"CMTE",0)),"^",4)+1
LDA ...S COMDA=COMDA+1
...L +^QA(741,IEN,"CMTE",COMDA):1 G:('$T)!($D(^QA(741,IEN,"CMTE",COMDA))) LDA
...S ^QA(741,IEN,"CMTE",COMDA,0)=CNVCOM_"^^^^"_VC
...S $P(^QA(741,IEN,"CMTE",0),"^",3,4)=COMDA_"^"_COMTTL
...;FIRE OFF XREFS
...S DA(1)=IEN,DA=COMDA,QAQADICT=741.017,QAQAFLD=.01,X=CNVCOM D ENSET^QAQAXREF
...S DA(1)=IEN,DA=COMDA,QAQADICT=741.017,QAQAFLD=4,X=VC D ENSET^QAQAXREF
...I COMMENTS]"" D
....S ^QA(741,IEN,"CMTE",COMDA,1,0)="^^1^1^"_VALDT_"^^"
....S ^QA(741,IEN,"CMTE",COMDA,1,1,0)=COMMENTS
....Q
...L -^QA(741,IEN,"CMTE",COMDA)
...S CNV=CNV+1
...Q
..Q
.Q
Q
ERROR ;
W !!,"&%%#^%#))^$$##$^*$&%&*^%#%^$$#%%$#&_(*&&*$^%#)*^^$^%#^$$#@&%#)#%&^$##"
W !?5,CNVMSG
W !?5,"Conversion has been stopped."
W !!,"&%%#^%#))^$$##$^*$&%&*^%#%^$$#%%$#&_(*&&*$^%#)*^^$^%#^$$#@&%#)#%&^$##"
D EXIT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOSCNVA 3951 printed Nov 22, 2024@17:31:23 Page 2
QAOSCNVA ;HISC/DDA-CONVERT VALADATED/COMFIRMED SYS/EQIP ISSUES ;1/3/94 15:49
+1 ;;3.0;Occurrence Screen;**6**;09/14/1993
INFO ; INFORMATION ABOUT THIS CONVERSION PROCESS.
+1 WRITE !!,"This conversion restores previous versions' SYSTEM and EQUIPMENT"
+2 WRITE !,"issues and makes them available for historical reporting via the"
+3 WRITE !,"option 'System/Equipment Problems' [QAOS RPT SYS/MGMT/EQUIP PROB]"
+4 WRITE !!,"As part of the conversion a non-committee place holder,"
+5 WRITE !,"VALIDATED/CONFIRMED, is added to the 'QA OCCURRENCE COMMITTEE'"
+6 WRITE !,"file (#741.97)."
+7 WRITE !!,"The actual conversion can be performed any number of times with"
+8 WRITE !,"no adverse impact on the data. If the conversion is interrupted"
+9 WRITE !,"for any reason, simply run this routine again."
+10 WRITE !,"++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++"
+11 ; HAVE USER PRESS RETURN TO CONTINUE
+12 SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
+13 IF Y'=1
SET CNVMSG="User stopped conversion process."
GOTO ERROR
+14 SET STARTIME=$PIECE($HOROLOG,",",2)
+15 WRITE !!,"Starting the conversion..."
ADDCOM WRITE !!,"Adding place holder committee - VALIDATED/CONFIRMED"
+1 WRITE !,"---------------------------------------------------"
+2 KILL DD,DIC,DINUM,DO
+3 SET X="VALIDATED/CONFIRMED"
+4 ; IF IT IS ALREADY IN THE FILE, SKIP TO THE CONVERSION
+5 SET CNVCOM=$ORDER(^QA(741.97,"B",X,""))
+6 if CNVCOM>0
GOTO LP
+7 SET DIC="^QA(741.97,"
SET DIC(0)="EL"
SET DIC("DR")="1///XX"
SET DLAYGO=741.97
DO FILE^DICN
IF Y=-1
SET CNVMSG="UNABLE TO ADD 'VALILATED/CONFIRMED' COMMITTEE TO FILE #741.97"
GOTO ERROR
+8 SET CNVCOM=+Y
KILL DIC,DLAYGO
LP WRITE !,"Done..."
+1 WRITE !!,"Moving VALIDATED/CONFIRMED data to the committee area"
+2 WRITE !,"-----------------------------------------------------"
+3 SET (CNT,CNV)=0
+4 DO NOW^%DTC
SET CNVDT=X
+5 DO WAIT^DICD
+6 DO LOOP
+7 WRITE !,"Done..."
+8 SET ENDTIME=$PIECE($HOROLOG,",",2)
SET %=ENDTIME-STARTIME
DO S^%DTC
+9 SET HOURS=+$EXTRACT(%,2,3)
SET MINUTES=+$EXTRACT(%,4,5)
SET SECONDS=+$EXTRACT(%,6,7)
+10 WRITE !!,"-----------------------------------------------------"
+11 WRITE !,"Total records checked: "_CNT_" Total records modified: "_CNV
+12 WRITE !,"Conversion completed in ",HOURS,"H ",MINUTES,"M ",SECONDS,"S."
EXIT KILL CNT,CNV,CNVCOM,CNVDT,CNVMSG,COMDA,COMIEN,COMMENTS,COMTTL,DA,DD,DIC,DINUM,DLAYGO,DO,ENDTIME,HOURS,IEN,MINUTES,OKAY,QAQADICT,QAQAFLD,SECONDS,STARTIME,VALDT,VC,X,Y,ZER0
+1 QUIT
LOOP ; LOOP VIA "AVAL" CROSS REFERENCE. ONLY THOSE RECORDS WITH A VALIDATION DATE ARE CHECKED.
+1 SET VALDT=0
+2 FOR
SET VALDT=$ORDER(^QA(741,"AVAL",VALDT))
if VALDT'>0
QUIT
SET IEN=0
FOR
SET IEN=$ORDER(^QA(741,"AVAL",VALDT,IEN))
if IEN'>0
QUIT
SET ZER0=$GET(^QA(741,IEN,0))
Begin DoDot:1
+3 SET CNT=CNT+1
+4 ; CONTINUE IF THERE IS ISSUE CODE DATA (VC)
+5 IF +$PIECE(ZER0,"^",20)'=0
Begin DoDot:2
+6 SET VC=$PIECE(ZER0,"^",20)
SET COMIEN=0
SET OKAY=1
+7 ; CHECK ALL COMMITTEE ENTRIES. CONTINUE IF NONE HAVE THE SAME ISSUE CODE (VC)
+8 FOR
if $DATA(^QA(741,IEN,"CMTE"))
SET COMIEN=$ORDER(^QA(741,IEN,"CMTE",COMIEN))
if COMIEN'>0
QUIT
IF $PIECE($GET(^QA(741,IEN,"CMTE",COMIEN,0)),"^",5)=VC
SET OKAY=0
+9 ; SET HEADER IF NO PREVIOUS COMMITTEE DATA
+10 IF OKAY
Begin DoDot:3
+11 ;SETUP AND STORE COMMITTEE DATA
+12 IF '$DATA(^QA(741,IEN,"CMTE"))
SET ^QA(741,IEN,"CMTE",0)="^741.017PA^"
+13 SET COMMENTS=$GET(^QA(741,IEN,1))
+14 SET COMDA=$PIECE($GET(^QA(741,IEN,"CMTE",0)),"^",3)
+15 SET COMTTL=$PIECE($GET(^QA(741,IEN,"CMTE",0)),"^",4)+1
LDA SET COMDA=COMDA+1
+1 LOCK +^QA(741,IEN,"CMTE",COMDA):1
if ('$TEST)!($DATA(^QA(741,IEN,"CMTE",COMDA)))
GOTO LDA
+2 SET ^QA(741,IEN,"CMTE",COMDA,0)=CNVCOM_"^^^^"_VC
+3 SET $PIECE(^QA(741,IEN,"CMTE",0),"^",3,4)=COMDA_"^"_COMTTL
+4 ;FIRE OFF XREFS
+5 SET DA(1)=IEN
SET DA=COMDA
SET QAQADICT=741.017
SET QAQAFLD=.01
SET X=CNVCOM
DO ENSET^QAQAXREF
+6 SET DA(1)=IEN
SET DA=COMDA
SET QAQADICT=741.017
SET QAQAFLD=4
SET X=VC
DO ENSET^QAQAXREF
+7 IF COMMENTS]""
Begin DoDot:4
+8 SET ^QA(741,IEN,"CMTE",COMDA,1,0)="^^1^1^"_VALDT_"^^"
+9 SET ^QA(741,IEN,"CMTE",COMDA,1,1,0)=COMMENTS
+10 QUIT
End DoDot:4
+11 LOCK -^QA(741,IEN,"CMTE",COMDA)
+12 SET CNV=CNV+1
+13 QUIT
End DoDot:3
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 QUIT
ERROR ;
+1 WRITE !!,"&%%#^%#))^$$##$^*$&%&*^%#%^$$#%%$#&_(*&&*$^%#)*^^$^%#^$$#@&%#)#%&^$##"
+2 WRITE !?5,CNVMSG
+3 WRITE !?5,"Conversion has been stopped."
+4 WRITE !!,"&%%#^%#))^$$##$^*$&%&*^%#%^$$#%%$#&_(*&&*$^%#)*^^$^%#^$$#@&%#)#%&^$##"
+5 DO EXIT
+6 QUIT
