- AMQQCMPC ; IHS/CMI/THL - AUTO SEARCH TEMPLATE GENERATION FROM EN3^AMQQ ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;-----
- RUN I AMQQEN31=+AMQQEN31 D DFN G EXIT
- D NAME
- EXIT K Y,X,AMQQEN31,I,%
- Q
- ;
- DOC F AMQQILIN=0:0 S AMQQILIN=$O(^UTILITY("AMQQ",$J,"LIST",AMQQILIN)) Q:'AMQQILIN S AMQQLX=^(AMQQILIN) D PARSE
- S ^UTILITY("AMQQ",$J,"DOC",.0001)=" ---"
- S DIE="^DIBT("
- S DA=AMQQEN31
- I '$D(^DIBT(AMQQEN31,"%D",0)) S ^(0)="^^0^0^"
- F AMQQILIN=0:0 S AMQQILIN=$O(^UTILITY("AMQQ",$J,"DOC",AMQQILIN)) Q:'AMQQILIN S DR="10///+"_^(AMQQILIN) D ^DIE
- K DIE,DA,DR,DIC
- Q
- ;
- PARSE N Y,Z,%,I
- S Z=""
- F I=1:1 S Y=$P(AMQQLX,",",I) Q:$P(AMQQLX,",",I,99)="" D TRANS I Y'="" S Z=Z_Y
- S ^UTILITY("AMQQ",$J,"DOC",AMQQILIN)=Z
- Q
- ;
- TRANS I $E(Y)="@" S Y="" Q
- I Y?1"W ?"1.N S %=+$P(Y,"?",2),Y="",$P(Y," ",%-1)="" Q
- S Y=$TR(Y,"""","")
- I Y[" [SER" S Y=$P(Y," [SER")
- Q
- ;
- DFN S AMQQDIBT=AMQQEN31+.1
- D MSG
- X AMQV(0)
- S AMQQEN3=AMQQTOT
- D DOC
- K ^DIBT(AMQQEN31,1)
- F %=0:0 S %=$O(^DIBT(AMQQDIBT,1,%)) Q:'% S ^DIBT(AMQQEN31,1,%)=""
- K ^DIBT(AMQQDIBT,1)
- S ^DIBT(AMQQEN31,1,0)=AMQQEN3
- Q
- ;
- NAME F Q:'$D(^DIBT("B",AMQQEN31)) S DA=$O(^(AMQQEN31,"")),DIK="^DIBT(" D ^DIK K DIC,DIK,DA
- S X=AMQQEN31
- S DIC="^DIBT("
- S DIC(0)="L"
- S DIADD=1
- S DIC("DR")="2////"_DT_";3////"_DUZ(0)_";4////9000001;5////"_DUZ
- D FILE^DICN
- K DIC,DIADD
- I Y=-1 S AMQQQUIT="" Q
- S (AMQQEN31,AMQQDIBT)=+Y
- D MSG
- X AMQV(0)
- S ^DIBT(AMQQEN31,1,0)=AMQQTOT
- S AMQQEN3=AMQQEN31
- D DOC
- Q
- ;
- MSG W !!,"I am about to conduct a search and save the results.",!
- W "Please be patient...",!!!
- H 3
- Q
- ;
- AMQQCMPC ; IHS/CMI/THL - AUTO SEARCH TEMPLATE GENERATION FROM EN3^AMQQ ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +2 ;-----
- RUN IF AMQQEN31=+AMQQEN31
- DO DFN
- GOTO EXIT
- +1 DO NAME
- EXIT KILL Y,X,AMQQEN31,I,%
- +1 QUIT
- +2 ;
- DOC FOR AMQQILIN=0:0
- SET AMQQILIN=$ORDER(^UTILITY("AMQQ",$JOB,"LIST",AMQQILIN))
- IF 'AMQQILIN
- QUIT
- SET AMQQLX=^(AMQQILIN)
- DO PARSE
- +1 SET ^UTILITY("AMQQ",$JOB,"DOC",.0001)=" ---"
- +2 SET DIE="^DIBT("
- +3 SET DA=AMQQEN31
- +4 IF '$DATA(^DIBT(AMQQEN31,"%D",0))
- SET ^(0)="^^0^0^"
- +5 FOR AMQQILIN=0:0
- SET AMQQILIN=$ORDER(^UTILITY("AMQQ",$JOB,"DOC",AMQQILIN))
- IF 'AMQQILIN
- QUIT
- SET DR="10///+"_^(AMQQILIN)
- DO ^DIE
- +6 KILL DIE,DA,DR,DIC
- +7 QUIT
- +8 ;
- PARSE NEW Y,Z,%,I
- +1 SET Z=""
- +2 FOR I=1:1
- SET Y=$PIECE(AMQQLX,",",I)
- IF $PIECE(AMQQLX,",",I,99)=""
- QUIT
- DO TRANS
- IF Y'=""
- SET Z=Z_Y
- +3 SET ^UTILITY("AMQQ",$JOB,"DOC",AMQQILIN)=Z
- +4 QUIT
- +5 ;
- TRANS IF $EXTRACT(Y)="@"
- SET Y=""
- QUIT
- +1 IF Y?1"W ?"1.N
- SET %=+$PIECE(Y,"?",2)
- SET Y=""
- SET $PIECE(Y," ",%-1)=""
- QUIT
- +2 SET Y=$TRANSLATE(Y,"""","")
- +3 IF Y[" [SER"
- SET Y=$PIECE(Y," [SER")
- +4 QUIT
- +5 ;
- DFN SET AMQQDIBT=AMQQEN31+.1
- +1 DO MSG
- +2 XECUTE AMQV(0)
- +3 SET AMQQEN3=AMQQTOT
- +4 DO DOC
- +5 KILL ^DIBT(AMQQEN31,1)
- +6 FOR %=0:0
- SET %=$ORDER(^DIBT(AMQQDIBT,1,%))
- IF '%
- QUIT
- SET ^DIBT(AMQQEN31,1,%)=""
- +7 KILL ^DIBT(AMQQDIBT,1)
- +8 SET ^DIBT(AMQQEN31,1,0)=AMQQEN3
- +9 QUIT
- +10 ;
- NAME FOR
- IF '$DATA(^DIBT("B",AMQQEN31))
- QUIT
- SET DA=$ORDER(^(AMQQEN31,""))
- SET DIK="^DIBT("
- DO ^DIK
- KILL DIC,DIK,DA
- +1 SET X=AMQQEN31
- +2 SET DIC="^DIBT("
- +3 SET DIC(0)="L"
- +4 SET DIADD=1
- +5 SET DIC("DR")="2////"_DT_";3////"_DUZ(0)_";4////9000001;5////"_DUZ
- +6 DO FILE^DICN
- +7 KILL DIC,DIADD
- +8 IF Y=-1
- SET AMQQQUIT=""
- QUIT
- +9 SET (AMQQEN31,AMQQDIBT)=+Y
- +10 DO MSG
- +11 XECUTE AMQV(0)
- +12 SET ^DIBT(AMQQEN31,1,0)=AMQQTOT
- +13 SET AMQQEN3=AMQQEN31
- +14 DO DOC
- +15 QUIT
- +16 ;
- MSG WRITE !!,"I am about to conduct a search and save the results.",!
- +1 WRITE "Please be patient...",!!!
- +2 HANG 3
- +3 QUIT
- +4 ;
