- 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