AQAOENTQ.m

AQAOENTQ ; IHS/ORDC/LJF - DISPLAY OCCURRENCES ENTERED ;

 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995

 ;

 ;This rtn is called by ^AQAOENTR to display all occurrences already

 ;entered for the combination of patient, occ date & indicator.  If

 ;any are found, user can select one or choose to add a new occurrence.

 ;

FIND ; >> find occurrences in file for patient, date & indicator

 S (AQAOX,AQAONUM)=0 K AQAO

 F  S AQAOX=$O(^AQAOC("AA",AQAOIND,AQAODATE,AQAOPAT,AQAOX)) Q:AQAOX=""  D

 .S AQAOST=$P($G(^AQAOC(AQAOX,1)),U) ;status codes

 .Q:AQAOST="2"  ;bypass deletd occ

 .S AQAOST=$S(AQAOST=0:"OPEN",AQAOST=1:"CLOSED",1:"") ;set status

 .S AQAOID=$P($G(^AQAOC(AQAOX,0)),U) ;case identifier

 .S AQAONUM=AQAONUM+1,X="     " ;set array

 .S AQAO(AQAONUM)=AQAOX_U_AQAOID_X_AQAOST_X_$P(^AQAO(2,+AQAOIND,0),U,2)

 .Q

 G EXIT:'$D(AQAO) ;no occ found

 ;

DISPLAY ; >> display occurrences found

 W !!?5,"*** OCCURRENCES FOUND FOR "

 W $P(^DPT(AQAOPAT,0),U)," FOR DATE SELECTED ***",!

 W !?3,"Case #      Status    Indicator"

 K DIR S DIR(0)="N^1:"_(AQAONUM+1),DIR("A")="Choose ONE from list"

 S DIR("A",(AQAONUM+1))=(AQAONUM+1)_". ADD NEW ENTRY"

 S AQAON=0 F  S AQAON=$O(AQAO(AQAON)) Q:AQAON=""  D

 .S DIR("A",AQAON)=AQAON_". "_$P(AQAO(AQAON),U,2)

 D ^DIR G EXIT:$D(DIRUT)

 I Y=(AQAONUM+1) K AQAO G EXIT ;user chose to add new entry

 I $P($P(AQAO(+Y),U,2),"     ",2)'="OPEN" D  G DISPLAY

 .W !!,"CASE NOT OPEN!  MUST BE REOPENED TO EDIT IT!"

 S AQAOIFN=$P(AQAO(+Y),U) ;user chose to edit an entry

 S AQAOCID=$P(AQAO(+Y),U,2)

 ;

EXIT ; >> return to calling routine

 Q

AQAOENTQ  ; IHS/ORDC/LJF - DISPLAY OCCURRENCES ENTERED ;

 +1       ;;1.01;QAI MANAGEMENT;;OCT 05, 1995

 +2       ;

 +3       ;This rtn is called by ^AQAOENTR to display all occurrences already

 +4       ;entered for the combination of patient, occ date & indicator.  If

 +5       ;any are found, user can select one or choose to add a new occurrence.

 +6       ;

FIND      ; >> find occurrences in file for patient, date & indicator

 +1        SET (AQAOX,AQAONUM)=0

           KILL AQAO

 +2        FOR 

               SET AQAOX=$ORDER(^AQAOC("AA",AQAOIND,AQAODATE,AQAOPAT,AQAOX))

               IF AQAOX=""

                   QUIT 

               Begin DoDot:1

 +3       ;status codes

                   SET AQAOST=$PIECE($GET(^AQAOC(AQAOX,1)),U)

 +4       ;bypass deletd occ

                   IF AQAOST="2"

                       QUIT 

 +5       ;set status

                   SET AQAOST=$SELECT(AQAOST=0:"OPEN",AQAOST=1:"CLOSED",1:"")

 +6       ;case identifier

                   SET AQAOID=$PIECE($GET(^AQAOC(AQAOX,0)),U)

 +7       ;set array

                   SET AQAONUM=AQAONUM+1

                   SET X="     "

 +8                SET AQAO(AQAONUM)=AQAOX_U_AQAOID_X_AQAOST_X_$PIECE(^AQAO(2,+AQAOIND,0),U,2)

 +9                QUIT 

               End DoDot:1

 +10      ;no occ found

           IF '$DATA(AQAO)

               GOTO EXIT

 +11      ;

DISPLAY   ; >> display occurrences found

 +1        WRITE !!?5,"*** OCCURRENCES FOUND FOR "

 +2        WRITE $PIECE(^DPT(AQAOPAT,0),U)," FOR DATE SELECTED ***",!

 +3        WRITE !?3,"Case #      Status    Indicator"

 +4        KILL DIR

           SET DIR(0)="N^1:"_(AQAONUM+1)

           SET DIR("A")="Choose ONE from list"

 +5        SET DIR("A",(AQAONUM+1))=(AQAONUM+1)_". ADD NEW ENTRY"

 +6        SET AQAON=0

           FOR 

               SET AQAON=$ORDER(AQAO(AQAON))

               IF AQAON=""

                   QUIT 

               Begin DoDot:1

 +7                SET DIR("A",AQAON)=AQAON_". "_$PIECE(AQAO(AQAON),U,2)

               End DoDot:1

 +8        DO ^DIR

           IF $DATA(DIRUT)

               GOTO EXIT

 +9       ;user chose to add new entry

           IF Y=(AQAONUM+1)

               KILL AQAO

               GOTO EXIT

 +10       IF $PIECE($PIECE(AQAO(+Y),U,2),"     ",2)'="OPEN"

               Begin DoDot:1

 +11               WRITE !!,"CASE NOT OPEN!  MUST BE REOPENED TO EDIT IT!"

               End DoDot:1

               GOTO DISPLAY

 +12      ;user chose to edit an entry

           SET AQAOIFN=$PIECE(AQAO(+Y),U)

 +13       SET AQAOCID=$PIECE(AQAO(+Y),U,2)

 +14      ;

EXIT      ; >> return to calling routine

 +1        QUIT