QAOEDT2 ;HISC/DAD-MISC EDITS ;7/26/93 12:27
;;3.0;Occurrence Screen;;09/14/1993
EN1 ; *** COMMITTEE EDIT
S QALIMIT="I $P(^(0),""^"",11)'>0",QAOSPROG="1^QAOEDT2" D EN2^QAOEDT
G EXIT
1 S QAOSWHAT="REVIEWED" D ENDISP^QAOUTL0
K DR S DIE="^QA(741,",DR="17",DR(2,741.017)=".01;4;10",DA=QAOSD0
D ^DIE S QAOSQUIT=$S($D(Y):1,1:0)
S QAUDIT("FILE")="741^27",QAUDIT("DA")=QAOSD0,QAUDIT("ACTION")="e"
S QAUDIT("COMMENT")="COMMITTEE REVIEW, OTHER THAN QA COMMITTEE"
D ^QAQAUDIT
Q
EN3 ; *** FINAL DISPOSITION
S QALIMIT="I +$P(^QA(741,+Y,0),""^"",11)=0,$O(^QA(741,+Y,""REVR"",0))"
S QAOSPROG="3^QAOEDT2" D EN2^QAOEDT G EXIT
3 S QAOSWHAT="CLOSED OUT" D ENDISP^QAOUTL0
K DR S DIE="^QA(741,",DR="14//TODAY;16;11//CLOSED",DA=QAOSD0
D ^DIE S QAOSQUIT=$S($D(Y):1,1:0)
S QAUDIT("FILE")="741^27",QAUDIT("DA")=QAOSD0,QAUDIT("ACTION")="c"
S QAUDIT("COMMENT")="CLOSE A RECORD" D ^QAQAUDIT
Q
EN4 ; *** DELETE
W !!,"Do you wish to see a list of deleted occurrences"
S %=2,LINE=1,QAOSQUIT=0 D YN^DICN Q:%=-1 G:%=2 DEL
I '% W !!?3,"Please answer Y(es) or N(o)" G EN4
W ! D WAIT^DICD W ! K ^TMP($J,"D")
F QAOSD0=0:0 S QAOSD0=$O(^QA(741,"AD",2,QAOSD0)) Q:QAOSD0'>0 D
. S LOC=^QA(741,QAOSD0,0),QAOSSCRN=+$G(^("SCRN")),QAOSWHO=+LOC
. S QAOSDATE=$P(LOC,"^",3)
. I $D(^DPT(QAOSWHO,0))#2 S QAOSWHO=$P(^(0),"^") D
.. S QAOSSCRN=+^QA(741.1,QAOSSCRN,0)
.. S ^TMP($J,"D",QAOSWHO,QAOSDATE,QAOSSCRN)=""
.. Q
. Q
I $O(^TMP($J,"D",""))="" W !?5,"*** NO DELETED OCCURRENCES FOUND ***" G DEL
S QAOSWHO="",LINE=$Y
F S QAOSWHO=$O(^TMP($J,"D",QAOSWHO)) Q:QAOSWHO=""!QAOSQUIT F QADATE=0:0 S QADATE=$O(^TMP($J,"D",QAOSWHO,QADATE)) Q:QADATE'>0!QAOSQUIT F QAOSSCRN=0:0 S QAOSSCRN=$O(^TMP($J,"D",QAOSWHO,QADATE,QAOSSCRN)) Q:QAOSSCRN'>0!QAOSQUIT D
. S Y=QADATE X ^DD("DD") W !?5,QAOSWHO,?30,Y,?50,QAOSSCRN
. Q:$Y'>(IOSL+LINE-3)
. K DIR S DIR(0)="E" D ^DIR K DIR
. S QAOSQUIT=$S(Y'>0:1,1:0),LINE=$Y
. Q
DEL ;
S QAOSPROG="DLT^QAOEDT2" D EN1^QAOEDT
G EXIT
DLT S QAOSWHAT="DELETED" D ENDISP^QAOUTL0 S (DIE,DIC)="^QA(741,"
ASKDEL W !!?5,"Delete this record (Y/N) " S %=2
D YN^DICN,YNOUT Q:%=2!QAOSQUIT
I %=0 W !!?10,"Please answer Y(es) or N(o)" G ASKDEL
S DR="11///^S X=2",DA=QAOSD0 D ^DIE
S QAUDIT("FILE")="741^27",QAUDIT("DA")=DA,QAUDIT("ACTION")="d"
S QAUDIT("COMMENT")="MARK A RECORD AS DELETED" D ^QAQAUDIT
W !!?5,"*** RECORD HAS BEEN DELETED ***",*7,!
Q
;
EXIT ;
K %,DA,DIC,DIE,DR,I,LINE,LOC,QA,QADATE,QALIMIT,QAOPCENT,QAOS,QAOSD0
K QAOSDATE,QAOSQUIT,QAOSWHAT,QAOSSCRN,QAUDIT,QAOSWHO,X,Y,QAOSTYPE
K QAOSONE,QAOSPROG
K ^TMP($J,"D")
Q
DIEOUT S QAOSQUIT=$S($D(DTOUT):1,$D(DUOUT):1,$D(Y):1,1:0) Q
YNOUT S QAOSQUIT=$S(%=-1:1,1:0) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOEDT2 2693 printed Dec 13, 2024@02:21:09 Page 2
QAOEDT2 ;HISC/DAD-MISC EDITS ;7/26/93 12:27
+1 ;;3.0;Occurrence Screen;;09/14/1993
EN1 ; *** COMMITTEE EDIT
+1 SET QALIMIT="I $P(^(0),""^"",11)'>0"
SET QAOSPROG="1^QAOEDT2"
DO EN2^QAOEDT
+2 GOTO EXIT
1 SET QAOSWHAT="REVIEWED"
DO ENDISP^QAOUTL0
+1 KILL DR
SET DIE="^QA(741,"
SET DR="17"
SET DR(2,741.017)=".01;4;10"
SET DA=QAOSD0
+2 DO ^DIE
SET QAOSQUIT=$SELECT($DATA(Y):1,1:0)
+3 SET QAUDIT("FILE")="741^27"
SET QAUDIT("DA")=QAOSD0
SET QAUDIT("ACTION")="e"
+4 SET QAUDIT("COMMENT")="COMMITTEE REVIEW, OTHER THAN QA COMMITTEE"
+5 DO ^QAQAUDIT
+6 QUIT
EN3 ; *** FINAL DISPOSITION
+1 SET QALIMIT="I +$P(^QA(741,+Y,0),""^"",11)=0,$O(^QA(741,+Y,""REVR"",0))"
+2 SET QAOSPROG="3^QAOEDT2"
DO EN2^QAOEDT
GOTO EXIT
3 SET QAOSWHAT="CLOSED OUT"
DO ENDISP^QAOUTL0
+1 KILL DR
SET DIE="^QA(741,"
SET DR="14//TODAY;16;11//CLOSED"
SET DA=QAOSD0
+2 DO ^DIE
SET QAOSQUIT=$SELECT($DATA(Y):1,1:0)
+3 SET QAUDIT("FILE")="741^27"
SET QAUDIT("DA")=QAOSD0
SET QAUDIT("ACTION")="c"
+4 SET QAUDIT("COMMENT")="CLOSE A RECORD"
DO ^QAQAUDIT
+5 QUIT
EN4 ; *** DELETE
+1 WRITE !!,"Do you wish to see a list of deleted occurrences"
+2 SET %=2
SET LINE=1
SET QAOSQUIT=0
DO YN^DICN
if %=-1
QUIT
if %=2
GOTO DEL
+3 IF '%
WRITE !!?3,"Please answer Y(es) or N(o)"
GOTO EN4
+4 WRITE !
DO WAIT^DICD
WRITE !
KILL ^TMP($JOB,"D")
+5 FOR QAOSD0=0:0
SET QAOSD0=$ORDER(^QA(741,"AD",2,QAOSD0))
if QAOSD0'>0
QUIT
Begin DoDot:1
+6 SET LOC=^QA(741,QAOSD0,0)
SET QAOSSCRN=+$GET(^("SCRN"))
SET QAOSWHO=+LOC
+7 SET QAOSDATE=$PIECE(LOC,"^",3)
+8 IF $DATA(^DPT(QAOSWHO,0))#2
SET QAOSWHO=$PIECE(^(0),"^")
Begin DoDot:2
+9 SET QAOSSCRN=+^QA(741.1,QAOSSCRN,0)
+10 SET ^TMP($JOB,"D",QAOSWHO,QAOSDATE,QAOSSCRN)=""
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 IF $ORDER(^TMP($JOB,"D",""))=""
WRITE !?5,"*** NO DELETED OCCURRENCES FOUND ***"
GOTO DEL
+14 SET QAOSWHO=""
SET LINE=$Y
+15 FOR
SET QAOSWHO=$ORDER(^TMP($JOB,"D",QAOSWHO))
if QAOSWHO=""!QAOSQUIT
QUIT
FOR QADATE=0:0
SET QADATE=$ORDER(^TMP($JOB,"D",QAOSWHO,QADATE))
if QADATE'>0!QAOSQUIT
QUIT
FOR QAOSSCRN=0:0
SET QAOSSCRN=$ORDER(^TMP($JOB,"D",QAOSWHO,QADATE,QAOSSCRN))
if QAOSSCRN'>0!QAOSQUIT
QUIT
Begin DoDot:1
+16 SET Y=QADATE
XECUTE ^DD("DD")
WRITE !?5,QAOSWHO,?30,Y,?50,QAOSSCRN
+17 if $Y'>(IOSL+LINE-3)
QUIT
+18 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+19 SET QAOSQUIT=$SELECT(Y'>0:1,1:0)
SET LINE=$Y
+20 QUIT
End DoDot:1
DEL ;
+1 SET QAOSPROG="DLT^QAOEDT2"
DO EN1^QAOEDT
+2 GOTO EXIT
DLT SET QAOSWHAT="DELETED"
DO ENDISP^QAOUTL0
SET (DIE,DIC)="^QA(741,"
ASKDEL WRITE !!?5,"Delete this record (Y/N) "
SET %=2
+1 DO YN^DICN
DO YNOUT
if %=2!QAOSQUIT
QUIT
+2 IF %=0
WRITE !!?10,"Please answer Y(es) or N(o)"
GOTO ASKDEL
+3 SET DR="11///^S X=2"
SET DA=QAOSD0
DO ^DIE
+4 SET QAUDIT("FILE")="741^27"
SET QAUDIT("DA")=DA
SET QAUDIT("ACTION")="d"
+5 SET QAUDIT("COMMENT")="MARK A RECORD AS DELETED"
DO ^QAQAUDIT
+6 WRITE !!?5,"*** RECORD HAS BEEN DELETED ***",*7,!
+7 QUIT
+8 ;
EXIT ;
+1 KILL %,DA,DIC,DIE,DR,I,LINE,LOC,QA,QADATE,QALIMIT,QAOPCENT,QAOS,QAOSD0
+2 KILL QAOSDATE,QAOSQUIT,QAOSWHAT,QAOSSCRN,QAUDIT,QAOSWHO,X,Y,QAOSTYPE
+3 KILL QAOSONE,QAOSPROG
+4 KILL ^TMP($JOB,"D")
+5 QUIT
DIEOUT SET QAOSQUIT=$SELECT($DATA(DTOUT):1,$DATA(DUOUT):1,$DATA(Y):1,1:0)
QUIT
YNOUT SET QAOSQUIT=$SELECT(%=-1:1,1:0)
QUIT
