- APSPOST1 ; IHS/DSD/ENM - POST CONVERSION RTN - ; [ 09/03/97 1:30 PM ]
- ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97
- ;CALLED BY PSOPOST
- ;This routine will move the Pharmacy System parameters from the
- ;IHS Systems file to the APSP Control file.
- ;
- EP ;EP - GET PHARMACY SITE(S)
- ;W !,"Converting Pharmacy System Parameters to IHS Systems File....",! ;IHS/DSD/ENM 01/08/97 COMMENTED OUT
- S U="^",APSPSIT=0,APSPSN="",APS=0,AP=0
- S:$G(^APSPCTRL("FLAG"))]"" APSPSIT=^APSPCTRL("FLAG")
- S APSP1=$G(^AUSYS(1,"PS",1,0)) Q:APSP1=0
- F AP=0:0 S APSPSIT=$O(^PS(59,"B",APSPSIT)) Q:APSPSIT="" F APS=0:0 S APSPSN=$O(^PS(59,"B",APSPSIT,APSPSN)) Q:'APSPSN D SET
- D FIN ;W !,"Done......",! ;IHS/DSD/ENM 01/08/97 COMMENTED OUT
- Q
- SET ;DINUM APSPCTRL FILE AND SET ZERO NODE
- Q:APSPSN=""
- K DD,D0
- S DINUM=APSPSN
- I $G(^APSPCTRL(APSPSN,0))]"" S DIK="^APSPCTRL(",DA=APSPSN D ^DIK
- S DIC="^APSPCTRL(",DIC(0)="",X=APSPSN D FILE^DICN G:Y'>0 EXIT
- S $P(^APSPCTRL(+Y,0),"^",2)="",$P(^APSPCTRL(+Y,0),"^",3)=$P(APSP1,"^",3),$P(^APSPCTRL(+Y,0),"^",4)=$P(APSP1,"^",4),$P(^APSPCTRL(+Y,0),"^",5)=$P(APSP1,"^",5)
- S $P(^APSPCTRL(+Y,0),"^",6)=$P(APSP1,"^",6),$P(^APSPCTRL(+Y,0),"^",7)=$P(APSP1,"^",7),$P(^APSPCTRL(+Y,0),"^",8)=$P(APSP1,"^",8),$P(^APSPCTRL(+Y,0),"^",9)=$P(APSP1,"^",9)
- S $P(^APSPCTRL(+Y,0),"^",10)=$P(APSP1,"^",10),$P(^APSPCTRL(+Y,0),"^",11)=$P(APSP1,"^",11),$P(^APSPCTRL(+Y,0),"^",12)=$P(APSP1,"^",12),$P(^APSPCTRL(+Y,0),"^",13)=$P(APSP1,"^",13)
- S $P(^APSPCTRL(+Y,0),"^",14)=$P(APSP1,"^",14),$P(^APSPCTRL(+Y,0),"^",15)=$P(APSP1,"^",15),$P(^APSPCTRL(+Y,0),"^",16)=$P(APSP1,"^",16),$P(^APSPCTRL(+Y,0),"^",17)=$P(APSP1,"^",17)
- S $P(^APSPCTRL(+Y,0),"^",18)=$P(APSP1,"^",18),$P(^APSPCTRL(+Y,0),"^",19)=$P(APSP1,"^",19),$P(^APSPCTRL(+Y,0),"^",21)=$P(APSP1,"^",21),$P(^APSPCTRL(+Y,0),"^",22)=$P(APSP1,"^",22)
- S $P(^APSPCTRL(+Y,0),"^",23)=$P(APSP1,"^",23),$P(^APSPCTRL(+Y,0),"^",24)=$P(APSP1,"^",24),$P(^APSPCTRL(+Y,0),"^",25)=$P(APSP1,"^",25),$P(^APSPCTRL(+Y,0),"^",26)=$P(APSP1,"^",26)
- S $P(^APSPCTRL(+Y,0),"^",27)=$P(APSP1,"^",27),$P(^APSPCTRL(+Y,0),"^",28)=$P(APSP1,"^",28),$P(^APSPCTRL(+Y,0),"^",29)=$P(APSP1,"^",29),$P(^APSPCTRL(+Y,0),"^",31)=$P(APSP1,"^",31)
- S $P(^APSPCTRL(+Y,0),"^",32)=$P(APSP1,"^",32),$P(^APSPCTRL(+Y,0),"^",33)=$P(APSP1,"^",33),$P(^APSPCTRL(+Y,0),"^",34)=$P(APSP1,"^",34),$P(^APSPCTRL(+Y,0),"^",35)="",$P(^APSPCTRL(+Y,0),"^",36)=$P(APSP1,"^",20)
- ;Index the newly created record
- S DIK="^APSPCTRL(",DA=+Y D IX1^DIK
- S ^APSPCTRL("FLAG")=APSPSIT
- Q
- ;
- FIN ;
- K AP,APS,APSP1,DA,DIC,DINUM,APSPSIT,APSPSN,^APSPCTRL("FLAG")
- EXIT Q
- APSPOST1 ; IHS/DSD/ENM - POST CONVERSION RTN - ; [ 09/03/97 1:30 PM ]
- +1 ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97
- +2 ;CALLED BY PSOPOST
- +3 ;This routine will move the Pharmacy System parameters from the
- +4 ;IHS Systems file to the APSP Control file.
- +5 ;
- EP ;EP - GET PHARMACY SITE(S)
- +1 ;W !,"Converting Pharmacy System Parameters to IHS Systems File....",! ;IHS/DSD/ENM 01/08/97 COMMENTED OUT
- +2 SET U="^"
- SET APSPSIT=0
- SET APSPSN=""
- SET APS=0
- SET AP=0
- +3 IF $GET(^APSPCTRL("FLAG"))]""
- SET APSPSIT=^APSPCTRL("FLAG")
- +4 SET APSP1=$GET(^AUSYS(1,"PS",1,0))
- IF APSP1=0
- QUIT
- +5 FOR AP=0:0
- SET APSPSIT=$ORDER(^PS(59,"B",APSPSIT))
- IF APSPSIT=""
- QUIT
- FOR APS=0:0
- SET APSPSN=$ORDER(^PS(59,"B",APSPSIT,APSPSN))
- IF 'APSPSN
- QUIT
- DO SET
- +6 ;W !,"Done......",! ;IHS/DSD/ENM 01/08/97 COMMENTED OUT
- DO FIN
- +7 QUIT
- SET ;DINUM APSPCTRL FILE AND SET ZERO NODE
- +1 IF APSPSN=""
- QUIT
- +2 KILL DD,D0
- +3 SET DINUM=APSPSN
- +4 IF $GET(^APSPCTRL(APSPSN,0))]""
- SET DIK="^APSPCTRL("
- SET DA=APSPSN
- DO ^DIK
- +5 SET DIC="^APSPCTRL("
- SET DIC(0)=""
- SET X=APSPSN
- DO FILE^DICN
- IF Y'>0
- GOTO EXIT
- +6 SET $PIECE(^APSPCTRL(+Y,0),"^",2)=""
- SET $PIECE(^APSPCTRL(+Y,0),"^",3)=$PIECE(APSP1,"^",3)
- SET $PIECE(^APSPCTRL(+Y,0),"^",4)=$PIECE(APSP1,"^",4)
- SET $PIECE(^APSPCTRL(+Y,0),"^",5)=$PIECE(APSP1,"^",5)
- +7 SET $PIECE(^APSPCTRL(+Y,0),"^",6)=$PIECE(APSP1,"^",6)
- SET $PIECE(^APSPCTRL(+Y,0),"^",7)=$PIECE(APSP1,"^",7)
- SET $PIECE(^APSPCTRL(+Y,0),"^",8)=$PIECE(APSP1,"^",8)
- SET $PIECE(^APSPCTRL(+Y,0),"^",9)=$PIECE(APSP1,"^",9)
- +8 SET $PIECE(^APSPCTRL(+Y,0),"^",10)=$PIECE(APSP1,"^",10)
- SET $PIECE(^APSPCTRL(+Y,0),"^",11)=$PIECE(APSP1,"^",11)
- SET $PIECE(^APSPCTRL(+Y,0),"^",12)=$PIECE(APSP1,"^",12)
- SET $PIECE(^APSPCTRL(+Y,0),"^",13)=$PIECE(APSP1,"^",13)
- +9 SET $PIECE(^APSPCTRL(+Y,0),"^",14)=$PIECE(APSP1,"^",14)
- SET $PIECE(^APSPCTRL(+Y,0),"^",15)=$PIECE(APSP1,"^",15)
- SET $PIECE(^APSPCTRL(+Y,0),"^",16)=$PIECE(APSP1,"^",16)
- SET $PIECE(^APSPCTRL(+Y,0),"^",17)=$PIECE(APSP1,"^",17)
- +10 SET $PIECE(^APSPCTRL(+Y,0),"^",18)=$PIECE(APSP1,"^",18)
- SET $PIECE(^APSPCTRL(+Y,0),"^",19)=$PIECE(APSP1,"^",19)
- SET $PIECE(^APSPCTRL(+Y,0),"^",21)=$PIECE(APSP1,"^",21)
- SET $PIECE(^APSPCTRL(+Y,0),"^",22)=$PIECE(APSP1,"^",22)
- +11 SET $PIECE(^APSPCTRL(+Y,0),"^",23)=$PIECE(APSP1,"^",23)
- SET $PIECE(^APSPCTRL(+Y,0),"^",24)=$PIECE(APSP1,"^",24)
- SET $PIECE(^APSPCTRL(+Y,0),"^",25)=$PIECE(APSP1,"^",25)
- SET $PIECE(^APSPCTRL(+Y,0),"^",26)=$PIECE(APSP1,"^",26)
- +12 SET $PIECE(^APSPCTRL(+Y,0),"^",27)=$PIECE(APSP1,"^",27)
- SET $PIECE(^APSPCTRL(+Y,0),"^",28)=$PIECE(APSP1,"^",28)
- SET $PIECE(^APSPCTRL(+Y,0),"^",29)=$PIECE(APSP1,"^",29)
- SET $PIECE(^APSPCTRL(+Y,0),"^",31)=$PIECE(APSP1,"^",31)
- +13 SET $PIECE(^APSPCTRL(+Y,0),"^",32)=$PIECE(APSP1,"^",32)
- SET $PIECE(^APSPCTRL(+Y,0),"^",33)=$PIECE(APSP1,"^",33)
- SET $PIECE(^APSPCTRL(+Y,0),"^",34)=$PIECE(APSP1,"^",34)
- SET $PIECE(^APSPCTRL(+Y,0),"^",35)=""
- SET $PIECE(^APSPCTRL(+Y,0),"^",36)=$PIECE(APSP1,"^",20)
- +14 ;Index the newly created record
- +15 SET DIK="^APSPCTRL("
- SET DA=+Y
- DO IX1^DIK
- +16 SET ^APSPCTRL("FLAG")=APSPSIT
- +17 QUIT
- +18 ;
- FIN ;
- +1 KILL AP,APS,APSP1,DA,DIC,DINUM,APSPSIT,APSPSN,^APSPCTRL("FLAG")
- EXIT QUIT
