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
