AQAOENTS ; IHS/ORDC/LJF - CREATE OCC FROM SEARCH TEMPL ;
;;1.01;QAI MANAGEMENT;;OCT 05, 1995
;
;This rtn is called by ^AQAOENTR if the user chose to create occ
;from a visit-based search template. The user is asked for the
;template name and indicator. Then it loops through all entries in
;the template, asking for occ date for each one as it creates
;occurrences. The case ID name is displayed for each.
;
W !!!,"CREATE OCCURRENCES FROM A VISIT SEARCH TEMPLATE",!!
TEMP ; >>> ask user for search template name
K DIC S DIC="^DIBT(",DIC(0)="AEMQZ"
S DIC("S")="I $P(^DIBT(Y,0),U,4)=9000010,$D(^DIBT(Y,1))" ;visit scrn
S DIC("?")="Must be a search template created on the Visit file!"
D ^DIC G EXIT:$D(DTOUT),EXIT:$D(DUOUT),EXIT:X="",TEMP:Y=-1
S AQAOTMP=+Y ;search template ifn
;
IND ; >>> ask user to select indicator
S Y=$$IND^AQAOLKP ;ask user to select an indicator for all visits
S AQAOIN=$S(Y>0:+Y,1:"")
I AQAOIN="" D I Y'=1 G IND
.W !!,"You have not selected an indicator"
.W !,"This means you must enter the indicator for each template entry."
.K DIR S DIR(0)="Y",DIR("B")="NO"
.S DIR("A")="Do you wish to continue" D ^DIR
;
W !!,"I will take all entries from the search template "
W $P(^DIBT(AQAOTMP,0),U)
W !,"and create occurrences for indicator "
W $S(AQAOIN="":"you select as each is entered.",1:$P(^AQAO(2,AQAOIN,0),U))
K DIR S DIR(0)="Y",DIR("B")="YES",DIR("A")="Is this correct" D ^DIR
I Y'=1 G TEMP
;
LOOP ; >>> loop thru template entries and create occ
S AQAOV=0,AQAOSTOP=""
F S AQAOV=$O(^DIBT(AQAOTMP,1,AQAOV)) Q:AQAOV="" Q:AQAOSTOP=U D
.W !! S L=0,DIC="^AUPNVSIT(",FLDS="[AQAO VISIT DATA]",BY="@NUMBER"
.S (TO,FR)=AQAOV,DHD="@@",IOP="HOME" D EN1^DIP
.S X=$P(^AUPNVSIT(AQAOV,0),U),X=$$FMTE^XLFDT($P(X,"."),1) ;PATCH 2
.S AQAODATE=$$OCCDT^AQAOLKP(X) Q:AQAODATE="" ;ask for occ dt;PATCH 2
.I $D(DIRUT)!(X=U) S AQAOSTOP=U Q
.S AQAOIND=$S(AQAOIN="":$$IND^AQAOLKP,1:AQAOIN) Q:AQAOIND="" ;ask ind
.I $D(DIRUT)!(X=U) S AQAOSTOP=U Q
.S AQAOPAT=$P(^AUPNVSIT(AQAOV,0),U,5) Q:AQAOPAT="" ;pat dfn
.D ^AQAOENTQ
.I $D(DIRUT)!(X=U) S AQAOSTOP=U Q
.I $D(AQAO) W !!,"Okay, I won't add another occurrence for this visit" Q
.K AQAOIFN D CREATE^AQAOLKP Q:'$D(AQAOIFN) ;create occ
.S DIE="^AQAOC(",DA=AQAOIFN,DR=".03////"_AQAOV D ^DIE ;stuff visit
.K DIR S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR
.I Y=0 S AQAOSTOP=U
;
;
EXIT ; >>> eoj
D KILL^AQAOUTIL Q
AQAOENTS ; IHS/ORDC/LJF - CREATE OCC FROM SEARCH TEMPL ;
+1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
+2 ;
+3 ;This rtn is called by ^AQAOENTR if the user chose to create occ
+4 ;from a visit-based search template. The user is asked for the
+5 ;template name and indicator. Then it loops through all entries in
+6 ;the template, asking for occ date for each one as it creates
+7 ;occurrences. The case ID name is displayed for each.
+8 ;
+9 WRITE !!!,"CREATE OCCURRENCES FROM A VISIT SEARCH TEMPLATE",!!
TEMP ; >>> ask user for search template name
+1 KILL DIC
SET DIC="^DIBT("
SET DIC(0)="AEMQZ"
+2 ;visit scrn
SET DIC("S")="I $P(^DIBT(Y,0),U,4)=9000010,$D(^DIBT(Y,1))"
+3 SET DIC("?")="Must be a search template created on the Visit file!"
+4 DO ^DIC
IF $DATA(DTOUT)
GOTO EXIT
IF $DATA(DUOUT)
GOTO EXIT
IF X=""
GOTO EXIT
IF Y=-1
GOTO TEMP
+5 ;search template ifn
SET AQAOTMP=+Y
+6 ;
IND ; >>> ask user to select indicator
+1 ;ask user to select an indicator for all visits
SET Y=$$IND^AQAOLKP
+2 SET AQAOIN=$SELECT(Y>0:+Y,1:"")
+3 IF AQAOIN=""
Begin DoDot:1
+4 WRITE !!,"You have not selected an indicator"
+5 WRITE !,"This means you must enter the indicator for each template entry."
+6 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="NO"
+7 SET DIR("A")="Do you wish to continue"
DO ^DIR
End DoDot:1
IF Y'=1
GOTO IND
+8 ;
+9 WRITE !!,"I will take all entries from the search template "
+10 WRITE $PIECE(^DIBT(AQAOTMP,0),U)
+11 WRITE !,"and create occurrences for indicator "
+12 WRITE $SELECT(AQAOIN="":"you select as each is entered.",1:$PIECE(^AQAO(2,AQAOIN,0),U))
+13 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="Is this correct"
DO ^DIR
+14 IF Y'=1
GOTO TEMP
+15 ;
LOOP ; >>> loop thru template entries and create occ
+1 SET AQAOV=0
SET AQAOSTOP=""
+2 FOR
SET AQAOV=$ORDER(^DIBT(AQAOTMP,1,AQAOV))
IF AQAOV=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:1
+3 WRITE !!
SET L=0
SET DIC="^AUPNVSIT("
SET FLDS="[AQAO VISIT DATA]"
SET BY="@NUMBER"
+4 SET (TO,FR)=AQAOV
SET DHD="@@"
SET IOP="HOME"
DO EN1^DIP
+5 ;PATCH 2
SET X=$PIECE(^AUPNVSIT(AQAOV,0),U)
SET X=$$FMTE^XLFDT($PIECE(X,"."),1)
+6 ;ask for occ dt;PATCH 2
SET AQAODATE=$$OCCDT^AQAOLKP(X)
IF AQAODATE=""
QUIT
+7 IF $DATA(DIRUT)!(X=U)
SET AQAOSTOP=U
QUIT
+8 ;ask ind
SET AQAOIND=$SELECT(AQAOIN="":$$IND^AQAOLKP,1:AQAOIN)
IF AQAOIND=""
QUIT
+9 IF $DATA(DIRUT)!(X=U)
SET AQAOSTOP=U
QUIT
+10 ;pat dfn
SET AQAOPAT=$PIECE(^AUPNVSIT(AQAOV,0),U,5)
IF AQAOPAT=""
QUIT
+11 DO ^AQAOENTQ
+12 IF $DATA(DIRUT)!(X=U)
SET AQAOSTOP=U
QUIT
+13 IF $DATA(AQAO)
WRITE !!,"Okay, I won't add another occurrence for this visit"
QUIT
+14 ;create occ
KILL AQAOIFN
DO CREATE^AQAOLKP
IF '$DATA(AQAOIFN)
QUIT
+15 ;stuff visit
SET DIE="^AQAOC("
SET DA=AQAOIFN
SET DR=".03////"_AQAOV
DO ^DIE
+16 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
+17 IF Y=0
SET AQAOSTOP=U
End DoDot:1
+18 ;
+19 ;
EXIT ; >>> eoj
+1 DO KILL^AQAOUTIL
QUIT