ABSPOSK2 ; IHS/FCS/DRS - winnow POS data ;
;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
Q
FIX57IDX ; EP - from 57^ABSPOSK
; Clean up the NON-FILEMAN indexes from 9002313.57
; ^ABSPTL("NON-FILEMAN","RXIRXR",RXI,RXR,N57)
; ^ABSPTL("NON-FILEMAN","RXIRXR",category,RXI,RXR,N57)
; ^ABSPTL("NON-FILEMAN","PCNDFN",PCNDFN,N57)
N ROOT S ROOT="^ABSPTL(""NON-FILEMAN"",""RXIRXR"")"
N RXI,RXR,N57
S RXI="" F S RXI=$O(@ROOT@(RXI)) Q:'RXI D
. S RXR="" F S RXR=$O(@ROOT@(RXI,RXR)) Q:RXR="" D
. . S N57=0 F S N57=$O(@ROOT@(RXI,RXR,N57)) Q:'N57 D
. . . I '$D(^ABSPTL(N57)) D
. . . . K @ROOT@(RXI,RXR,N57)
; at this point, RXI=the first "category"
N CAT S CAT=RXI
F D S CAT=$O(@ROOT@(CAT)) Q:CAT=""
. S RXI="" F S RXI=$O(@ROOT@(CAT,RXI)) Q:'RXI D
. . S RXR="" F S RXR=$O(@ROOT@(CAT,RXI,RXR)) Q:RXR="" D
. . . S N57="" F S N57=$O(@ROOT@(CAT,RXI,RXR,N57)) Q:'N57 D
. . . . I '$D(^ABSPTL(N57)) D
. . . . . K @ROOT@(CAT,RXI,RXR,N57)
; and now the PCNDFNs
S ROOT="^ABSPTL(""NON-FILEMAN"",""PCNDFN"")"
N PCNDFN S PCNDFN=0
F S PCNDFN=$O(@ROOT@(PCNDFN)) Q:'PCNDFN D
. S CAT="" F S CAT=$O(@ROOT@(CAT,PCNDFN)) Q:CAT="" D
. . S N57=0 F S N57=$O(@ROOT@(CAT,PCNDFN,N57)) Q:'N57 D
. . . I '$D(^ABSPTL(N57)) D
. . . . K @ROOT@(CAT,PCNDFN,N57)
Q
ABSPOSK2 ; IHS/FCS/DRS - winnow POS data ;
+1 ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
+2 QUIT
FIX57IDX ; EP - from 57^ABSPOSK
+1 ; Clean up the NON-FILEMAN indexes from 9002313.57
+2 ; ^ABSPTL("NON-FILEMAN","RXIRXR",RXI,RXR,N57)
+3 ; ^ABSPTL("NON-FILEMAN","RXIRXR",category,RXI,RXR,N57)
+4 ; ^ABSPTL("NON-FILEMAN","PCNDFN",PCNDFN,N57)
+5 NEW ROOT
SET ROOT="^ABSPTL(""NON-FILEMAN"",""RXIRXR"")"
+6 NEW RXI,RXR,N57
+7 SET RXI=""
FOR
SET RXI=$ORDER(@ROOT@(RXI))
IF 'RXI
QUIT
Begin DoDot:1
+8 SET RXR=""
FOR
SET RXR=$ORDER(@ROOT@(RXI,RXR))
IF RXR=""
QUIT
Begin DoDot:2
+9 SET N57=0
FOR
SET N57=$ORDER(@ROOT@(RXI,RXR,N57))
IF 'N57
QUIT
Begin DoDot:3
+10 IF '$DATA(^ABSPTL(N57))
Begin DoDot:4
+11 KILL @ROOT@(RXI,RXR,N57)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+12 ; at this point, RXI=the first "category"
+13 NEW CAT
SET CAT=RXI
+14 FOR
Begin DoDot:1
+15 SET RXI=""
FOR
SET RXI=$ORDER(@ROOT@(CAT,RXI))
IF 'RXI
QUIT
Begin DoDot:2
+16 SET RXR=""
FOR
SET RXR=$ORDER(@ROOT@(CAT,RXI,RXR))
IF RXR=""
QUIT
Begin DoDot:3
+17 SET N57=""
FOR
SET N57=$ORDER(@ROOT@(CAT,RXI,RXR,N57))
IF 'N57
QUIT
Begin DoDot:4
+18 IF '$DATA(^ABSPTL(N57))
Begin DoDot:5
+19 KILL @ROOT@(CAT,RXI,RXR,N57)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
SET CAT=$ORDER(@ROOT@(CAT))
IF CAT=""
QUIT
+20 ; and now the PCNDFNs
+21 SET ROOT="^ABSPTL(""NON-FILEMAN"",""PCNDFN"")"
+22 NEW PCNDFN
SET PCNDFN=0
+23 FOR
SET PCNDFN=$ORDER(@ROOT@(PCNDFN))
IF 'PCNDFN
QUIT
Begin DoDot:1
+24 SET CAT=""
FOR
SET CAT=$ORDER(@ROOT@(CAT,PCNDFN))
IF CAT=""
QUIT
Begin DoDot:2
+25 SET N57=0
FOR
SET N57=$ORDER(@ROOT@(CAT,PCNDFN,N57))
IF 'N57
QUIT
Begin DoDot:3
+26 IF '$DATA(^ABSPTL(N57))
Begin DoDot:4
+27 KILL @ROOT@(CAT,PCNDFN,N57)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+28 QUIT
