- 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
