Routine: QAOSCNVA

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

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

ERROR ;

 W !!,"&%%#^%#))^$$##$^*$&%&*^%#%^$$#%%$#&_(*&&*$^%#)*^^$^%#^$$#@&%#)#%&^$##"

 W !?5,CNVMSG

 W !?5,"Conversion has been stopped."

 W !!,"&%%#^%#))^$$##$^*$&%&*^%#%^$$#%%$#&_(*&&*$^%#)*^^$^%#^$$#@&%#)#%&^$##"

 D EXIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOSCNVA   3951     printed  Mar 13, 2025@21:26:21                                                                                                                                                                                                    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

QAOSCNVA.m