- AQAOPAR1 ; IHS/ORDC/LJF - ADT SERVICE LINKS ;
- ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
- ;
- ;This rtn contains an entry point called by ^AQAOPAR. The code deals
- ;with the user interface in assigning services to each RPMS link.
- ;
- CURRENT ;ENTRY POINT >>> find all services currently linked
- S AQAODR1=".0"_($E(AQAOI,3)+2) ;yes/no field
- S X="1"_($E(AQAOI,3)+2),AQAODR2=$S($D(^DD(9002166.42,X,0)):X,1:"") ;#
- ;
- W @IOF,!!?20,"SERVICES CURRENTLY LINKED TO "
- W $P(^DD(9002166.4,AQAOI,0),U),!!
- K AQAOCUR S AQAOX=0 ;get service ifns
- F S AQAOX=$O(^AQAGP(AQAOFAC,"SRV",AQAOX)) Q:AQAOX'=+AQAOX D
- .K DIQ K ^UTILITY("DIQ1",$J) S DIC=9002166.4,DA=AQAOFAC,DR="9000"
- .S (AQAODA,DA(9002166.42))=AQAOX
- .S (AQAODR,DR(9002166.42))=".01;"_AQAODR1
- .D EN^DIQ1 Q:^UTILITY("DIQ1",$J,9002166.42,AQAODA,AQAODR1)'="YES"
- .S AQAOCUR(AQAOX)=^UTILITY("DIQ1",$J,9002166.42,AQAODA,.01)
- ;
- I '$D(AQAOCUR) W !!,"NO SERVICES CURRENTLY LINKED",! G ADD
- ;
- W !! S AQAOX=0
- F S AQAOX=$O(AQAOCUR(AQAOX)) Q:AQAOX="" D
- .W !,AQAOCUR(AQAOX)
- .I AQAODR2]"" D
- ..K ^UTILITY("DIQ1",$J) S DIC="^AQAGP(",DA=AQAOFAC,DR="9000"
- ..S (AQAODA,DA(9002166.42))=AQAOX
- ..S (AQAODR,DR(9002166.42))=AQAODR2 D EN^DIQ1
- ..W ?40,^UTILITY("DIQ1",$J,9002166.42,AQAODA,AQAODR)," DAYS"
- ;
- EDIT ; >>> ask if user wants to edit or delete any current services
- W !! K DIR S DIR(0)="YO",DIR("B")="NO"
- S DIR("A")="Do you want to EDIT or DELETE any current services"
- D ^DIR G EXIT:$D(DIRUT),ADD:Y=0
- ;
- W !!!,">>> MODIFY/DELETE MODE . . ."
- CHOOSE1 W !! K DIC,DIR S DIC="^AQAGP("_AQAOFAC_",""SRV"",",DIC(0)="AEMQZ"
- S DIC("S")="I $D(AQAOCUR(Y))" D ^DIC
- G EXIT:X=U,EXIT:$D(DTOUT),ADD:X="",CHOOSE1:Y=-1
- K DIE S DIE="^AQAGP("_AQAOFAC_",""SRV"","
- S DA=+Y,DA(1)=AQAOFAC,DR=AQAODR1_";"_AQAODR2 D ^DIE
- G CHOOSE1
- ;
- ;
- ADD ; >>> ask if user wants to add new services
- W !! K DIR S DIR(0)="YO",DIR("B")="NO"
- S DIR("A")="Do you want to ADD any new services to this link"
- D ^DIR G EXIT:$D(DIRUT),EXIT:Y=0
- ;
- W !!!,">>> ADD MODE . . ."
- CHOOSE2 W !! K DIC,DIR S DIC="^DIC(49,",DIC(0)="AEMQZ"
- D ^DIC G EXIT:X=U,EXIT:$D(DTOUT),EXIT:X="",CHOOSE2:Y=-1 S AQAOY=+Y
- I '$D(^AQAGP(AQAOFAC,"SRV","B",+Y)) D ;add serv multiple
- .S ^AQAGP(AQAOFAC,"SRV",0)="^9002166.42P"
- .S DIC(0)="L",DIC="^AQAGP("_AQAOFAC_",""SRV"",",DA(1)=AQAOFAC
- .S X=$P(Y,U,2) D ^DIC
- K DIE S DIE="^AQAGP("_AQAOFAC_",""SRV"",",DA(1)=AQAOFAC
- S DA=$O(^AQAGP(AQAOFAC,"SRV","B",AQAOY,0)),DR=AQAODR1_"////1;"_AQAODR2
- I DA]"" D ^DIE
- G CHOOSE2
- ;
- ;
- EXIT ; >>> eoj
- Q ;return to calling rtn AQAOPAR
- AQAOPAR1 ; IHS/ORDC/LJF - ADT SERVICE LINKS ;
- +1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
- +2 ;
- +3 ;This rtn contains an entry point called by ^AQAOPAR. The code deals
- +4 ;with the user interface in assigning services to each RPMS link.
- +5 ;
- CURRENT ;ENTRY POINT >>> find all services currently linked
- +1 ;yes/no field
- SET AQAODR1=".0"_($EXTRACT(AQAOI,3)+2)
- +2 ;#
- SET X="1"_($EXTRACT(AQAOI,3)+2)
- SET AQAODR2=$SELECT($DATA(^DD(9002166.42,X,0)):X,1:"")
- +3 ;
- +4 WRITE @IOF,!!?20,"SERVICES CURRENTLY LINKED TO "
- +5 WRITE $PIECE(^DD(9002166.4,AQAOI,0),U),!!
- +6 ;get service ifns
- KILL AQAOCUR
- SET AQAOX=0
- +7 FOR
- SET AQAOX=$ORDER(^AQAGP(AQAOFAC,"SRV",AQAOX))
- IF AQAOX'=+AQAOX
- QUIT
- Begin DoDot:1
- +8 KILL DIQ
- KILL ^UTILITY("DIQ1",$JOB)
- SET DIC=9002166.4
- SET DA=AQAOFAC
- SET DR="9000"
- +9 SET (AQAODA,DA(9002166.42))=AQAOX
- +10 SET (AQAODR,DR(9002166.42))=".01;"_AQAODR1
- +11 DO EN^DIQ1
- IF ^UTILITY("DIQ1",$JOB,9002166.42,AQAODA,AQAODR1)'="YES"
- QUIT
- +12 SET AQAOCUR(AQAOX)=^UTILITY("DIQ1",$JOB,9002166.42,AQAODA,.01)
- End DoDot:1
- +13 ;
- +14 IF '$DATA(AQAOCUR)
- WRITE !!,"NO SERVICES CURRENTLY LINKED",!
- GOTO ADD
- +15 ;
- +16 WRITE !!
- SET AQAOX=0
- +17 FOR
- SET AQAOX=$ORDER(AQAOCUR(AQAOX))
- IF AQAOX=""
- QUIT
- Begin DoDot:1
- +18 WRITE !,AQAOCUR(AQAOX)
- +19 IF AQAODR2]""
- Begin DoDot:2
- +20 KILL ^UTILITY("DIQ1",$JOB)
- SET DIC="^AQAGP("
- SET DA=AQAOFAC
- SET DR="9000"
- +21 SET (AQAODA,DA(9002166.42))=AQAOX
- +22 SET (AQAODR,DR(9002166.42))=AQAODR2
- DO EN^DIQ1
- +23 WRITE ?40,^UTILITY("DIQ1",$JOB,9002166.42,AQAODA,AQAODR)," DAYS"
- End DoDot:2
- End DoDot:1
- +24 ;
- EDIT ; >>> ask if user wants to edit or delete any current services
- +1 WRITE !!
- KILL DIR
- SET DIR(0)="YO"
- SET DIR("B")="NO"
- +2 SET DIR("A")="Do you want to EDIT or DELETE any current services"
- +3 DO ^DIR
- IF $DATA(DIRUT)
- GOTO EXIT
- IF Y=0
- GOTO ADD
- +4 ;
- +5 WRITE !!!,">>> MODIFY/DELETE MODE . . ."
- CHOOSE1 WRITE !!
- KILL DIC,DIR
- SET DIC="^AQAGP("_AQAOFAC_",""SRV"","
- SET DIC(0)="AEMQZ"
- +1 SET DIC("S")="I $D(AQAOCUR(Y))"
- DO ^DIC
- +2 IF X=U
- GOTO EXIT
- IF $DATA(DTOUT)
- GOTO EXIT
- IF X=""
- GOTO ADD
- IF Y=-1
- GOTO CHOOSE1
- +3 KILL DIE
- SET DIE="^AQAGP("_AQAOFAC_",""SRV"","
- +4 SET DA=+Y
- SET DA(1)=AQAOFAC
- SET DR=AQAODR1_";"_AQAODR2
- DO ^DIE
- +5 GOTO CHOOSE1
- +6 ;
- +7 ;
- ADD ; >>> ask if user wants to add new services
- +1 WRITE !!
- KILL DIR
- SET DIR(0)="YO"
- SET DIR("B")="NO"
- +2 SET DIR("A")="Do you want to ADD any new services to this link"
- +3 DO ^DIR
- IF $DATA(DIRUT)
- GOTO EXIT
- IF Y=0
- GOTO EXIT
- +4 ;
- +5 WRITE !!!,">>> ADD MODE . . ."
- CHOOSE2 WRITE !!
- KILL DIC,DIR
- SET DIC="^DIC(49,"
- SET DIC(0)="AEMQZ"
- +1 DO ^DIC
- IF X=U
- GOTO EXIT
- IF $DATA(DTOUT)
- GOTO EXIT
- IF X=""
- GOTO EXIT
- IF Y=-1
- GOTO CHOOSE2
- SET AQAOY=+Y
- +2 ;add serv multiple
- IF '$DATA(^AQAGP(AQAOFAC,"SRV","B",+Y))
- Begin DoDot:1
- +3 SET ^AQAGP(AQAOFAC,"SRV",0)="^9002166.42P"
- +4 SET DIC(0)="L"
- SET DIC="^AQAGP("_AQAOFAC_",""SRV"","
- SET DA(1)=AQAOFAC
- +5 SET X=$PIECE(Y,U,2)
- DO ^DIC
- End DoDot:1
- +6 KILL DIE
- SET DIE="^AQAGP("_AQAOFAC_",""SRV"","
- SET DA(1)=AQAOFAC
- +7 SET DA=$ORDER(^AQAGP(AQAOFAC,"SRV","B",AQAOY,0))
- SET DR=AQAODR1_"////1;"_AQAODR2
- +8 IF DA]""
- DO ^DIE
- +9 GOTO CHOOSE2
- +10 ;
- +11 ;
- EXIT ; >>> eoj
- +1 ;return to calling rtn AQAOPAR
- QUIT
