- PSO52EX ;BHAM ISC/AGV - API FOR ORIGINAL, REFILL, AND PARTIAL DATA ;06/03/16 17:07
- ;;7.0;OUTPATIENT PHARMACY;**252,267,441**;DEC 1997;Build 208
- ;
- ;REFERENCE TO ^DPT SUPPORTED BY DBIA 10035
- ;REFERENCE TO ^PSDRUG SUPPORTED BY DBIA 221
- ;
- ;
- ;SDATE: START DATE OF RECORD RETRIEVAL [REQUIRED]
- ;EDATE: END DATE OF RECORD RETRIEVAL [OPTIONAL]
- ;LIST: SUBSCRIPT NAME USED IN ^TMP GLOBAL [REQUIRED]
- ;
- Q:$G(LIST)=""
- K ^TMP($J,LIST)
- I '$G(SDATE) S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
- I '$G(EDATE) S EDATE=DT
- D SEND
- Q
- ;
- SEND ;SENDS CONTROL TO $$CROSS. RECEIVES AND TRACKS COUNTS.
- N ALCOUNT S ALCOUNT=$$CROSS("AL")
- N AMCOUNT S AMCOUNT=$$CROSS("AM")
- N TCOUNT S TCOUNT=ALCOUNT+AMCOUNT
- IF TCOUNT>0 S ^TMP($J,LIST,0)=TCOUNT
- ELSE S ^TMP($J,LIST,0)="-1^NO DATA FOUND"
- Q
- ;
- CROSS(REF) ;SETS UP ^TMP GLOBAL. SENDS FOR ORIGINAL, REFILL AND/OR PARTIAL FILL DATA
- N PSOIEN,PSOFILL,PSOCOUNT,DATE,END
- S DATE=SDATE-.001,END=(EDATE+1),PSOIEN="",PSOFILL="",PSOCOUNT=0
- F S DATE=$O(^PSRX(REF,DATE)) Q:'DATE!(END'>DATE) D
- .F S PSOIEN=$O(^PSRX(REF,DATE,PSOIEN)) Q:'PSOIEN D
- ..F S PSOFILL=$O(^PSRX(REF,DATE,PSOIEN,PSOFILL)) Q:PSOFILL="" D
- ...S ^TMP($J,LIST,REF,DATE,PSOIEN,PSOFILL)=""
- ...I REF="AL",PSOFILL=0 S PSOCOUNT=PSOCOUNT+1 D ORIG(PSOIEN) Q
- ...I REF="AL",PSOFILL>0 S PSOCOUNT=PSOCOUNT+1 D REFILL(PSOIEN,PSOFILL) Q
- ...I REF="AM" S PSOCOUNT=PSOCOUNT+1 D PART(PSOIEN,PSOFILL) Q
- Q PSOCOUNT
- ;
- REFILL(IEN,FILL) ;REFILL
- D:'$D(^TMP($J,LIST,IEN,.01)) ORIG(IEN)
- N PSORFL S PSORFL=$G(^PSRX(IEN,1,FILL,0))
- S ^TMP($J,LIST,IEN,"RF",FILL,.01)=$P(PSORFL,U,1)_"^"_$$FMTE^XLFDT($P(PSORFL,U,1),1)
- S ^TMP($J,LIST,IEN,"RF",FILL,1)=$P(PSORFL,U,4)
- S ^TMP($J,LIST,IEN,"RF",FILL,1.1)=$P(PSORFL,U,10)
- S ^TMP($J,LIST,IEN,"RF",FILL,1.2)=$P(PSORFL,U,11)
- S ^TMP($J,LIST,IEN,"RF",0)=$G(^TMP($J,LIST,IEN,"RF",0))+1
- Q
- ;
- PART(IEN,FILL) ;PARTIAL FILL
- D:'$D(^TMP($J,LIST,IEN,.01)) ORIG(IEN)
- N PSOPART S PSOPART=$G(^PSRX(IEN,"P",FILL,0))
- S ^TMP($J,LIST,IEN,"P",FILL,.01)=$P(PSOPART,U,1)_"^"_$$FMTE^XLFDT($P(PSOPART,U,1),1)
- S ^TMP($J,LIST,IEN,"P",FILL,.04)=$P(PSOPART,U,4)
- S ^TMP($J,LIST,IEN,"P",FILL,.041)=$P(PSOPART,U,10)
- S ^TMP($J,LIST,IEN,"P",FILL,.042)=$P(PSOPART,U,11)
- S ^TMP($J,LIST,IEN,"P",0)=$G(^TMP($J,LIST,IEN,"P",0))+1
- Q
- ;
- ORIG(IEN) ;ORIGINAL FILL
- N PSOORIG S PSOORIG=$G(^PSRX(IEN,0))
- S ^TMP($J,LIST,IEN,.01)=$P(PSOORIG,U,1)
- S ^TMP($J,LIST,IEN,2)=$S($P(PSOORIG,U,2)>0:$P(PSOORIG,U,2)_"^"_$P($G(^DPT($P($G(PSOORIG),U,2),0)),U,1),1:"")
- S ^TMP($J,LIST,IEN,6)=$S($P(PSOORIG,U,6)>0:$P(PSOORIG,U,6)_"^"_$P($G(^PSDRUG($P($G(PSOORIG),U,6),0)),U,1),1:"")
- S ^TMP($J,LIST,IEN,7)=$P(PSOORIG,U,7)
- S ^TMP($J,LIST,IEN,8)=$P(PSOORIG,U,8)
- S ^TMP($J,LIST,IEN,17)=$P(PSOORIG,U,17)
- Q
- ;
- REF(SDATE,EDATE,LIST) ; "AD" XREF RETRIEVAL
- ;SDATE: START DATE OF "AD" XREF RETRIEVAL [REQUIRED]
- ;EDATE: END DATE OF "AD" XREF RETRIEVAL [OPTIONAL]
- ;LIST: SUBSCRIPT NAME USED IN ^TMP GLOBAL [REQUIRED]
- ;
- Q:$G(LIST)=""
- K ^TMP($J,LIST)
- I '$G(SDATE) S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
- I '$G(EDATE) S EDATE=SDATE
- N PSORXN,PSOFILL
- S DATE=SDATE-.001,END=EDATE+1,PSORXN="",PSOFILL=""
- F S DATE=$O(^PSRX("AD",DATE)) Q:'DATE!(END'>DATE) D
- .F S PSORXN=$O(^PSRX("AD",DATE,PSORXN)) Q:'PSORXN D
- ..F S PSOFILL=$O(^PSRX("AD",DATE,PSORXN,PSOFILL)) Q:PSOFILL="" D
- ...S ^TMP($J,LIST,"AD",DATE,PSORXN,PSOFILL)=""
- Q
- ;
- ARXREF(PSODATE,PSOIEN,PSOFILL) ; SUSPENSE STATUS CHECK
- ;PSODATE: RELEASED DATE/TIME
- ;PSOIEN: INTERNAL ENTRY NUMBER
- ;PSOFILL: FILL NUMBER OF PRESCRIPTION
- ;
- I $G(PSODATE)=""!($G(PSOIEN)="")!($G(PSOFILL)="") Q 0
- N RESULT S RESULT=0
- I $D(^PSRX("AR",PSODATE,PSOIEN,PSOFILL)) S RESULT=1
- Q RESULT
- ;
- PARK(ORIEN) ; DETERMINES IF A PRESCRIPTION IS PARK
- ;ORIEN: ORDER FILE (#100) INTERNAL ENTRY NUMBER
- ;
- I $G(ORIEN)="" Q 0
- N PSOIEN
- S PSOIEN=$O(^PSRX("APL",ORIEN,""))
- I +PSOIEN=0 Q 0
- I $G(^PSRX(PSOIEN,"STA"))'=0 Q 0
- N RESULT S RESULT=0
- I $G(^PSRX(PSOIEN,"PARK"))=1 S RESULT=1
- Q RESULT
- SUSP(ORIEN) ; DETERMINES IF A PRESCRIPTION IS SUSPENDED
- ;ORIEN: ORDER FILE (#100) INTERNAL ENTRY NUMBER
- ;
- I $G(ORIEN)="" Q 0
- N PSOIEN
- S PSOIEN=$O(^PSRX("APL",ORIEN,""))
- I +PSOIEN=0 Q 0
- I $G(^PSRX(PSOIEN,"STA"))=5 Q 1
- Q 0
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO52EX 4287 printed Feb 18, 2025@23:49:30 Page 2
- PSO52EX ;BHAM ISC/AGV - API FOR ORIGINAL, REFILL, AND PARTIAL DATA ;06/03/16 17:07
- +1 ;;7.0;OUTPATIENT PHARMACY;**252,267,441**;DEC 1997;Build 208
- +2 ;
- +3 ;REFERENCE TO ^DPT SUPPORTED BY DBIA 10035
- +4 ;REFERENCE TO ^PSDRUG SUPPORTED BY DBIA 221
- +5 ;
- +6 ;
- +1 ;SDATE: START DATE OF RECORD RETRIEVAL [REQUIRED]
- +2 ;EDATE: END DATE OF RECORD RETRIEVAL [OPTIONAL]
- +3 ;LIST: SUBSCRIPT NAME USED IN ^TMP GLOBAL [REQUIRED]
- +4 ;
- +5 if $GET(LIST)=""
- QUIT
- +6 KILL ^TMP($JOB,LIST)
- +7 IF '$GET(SDATE)
- SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"
- QUIT
- +8 IF '$GET(EDATE)
- SET EDATE=DT
- +9 DO SEND
- +10 QUIT
- +11 ;
- SEND ;SENDS CONTROL TO $$CROSS. RECEIVES AND TRACKS COUNTS.
- +1 NEW ALCOUNT
- SET ALCOUNT=$$CROSS("AL")
- +2 NEW AMCOUNT
- SET AMCOUNT=$$CROSS("AM")
- +3 NEW TCOUNT
- SET TCOUNT=ALCOUNT+AMCOUNT
- +4 IF TCOUNT>0
- SET ^TMP($JOB,LIST,0)=TCOUNT
- +5 IF '$TEST
- SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"
- +6 QUIT
- +7 ;
- CROSS(REF) ;SETS UP ^TMP GLOBAL. SENDS FOR ORIGINAL, REFILL AND/OR PARTIAL FILL DATA
- +1 NEW PSOIEN,PSOFILL,PSOCOUNT,DATE,END
- +2 SET DATE=SDATE-.001
- SET END=(EDATE+1)
- SET PSOIEN=""
- SET PSOFILL=""
- SET PSOCOUNT=0
- +3 FOR
- SET DATE=$ORDER(^PSRX(REF,DATE))
- if 'DATE!(END'>DATE)
- QUIT
- Begin DoDot:1
- +4 FOR
- SET PSOIEN=$ORDER(^PSRX(REF,DATE,PSOIEN))
- if 'PSOIEN
- QUIT
- Begin DoDot:2
- +5 FOR
- SET PSOFILL=$ORDER(^PSRX(REF,DATE,PSOIEN,PSOFILL))
- if PSOFILL=""
- QUIT
- Begin DoDot:3
- +6 SET ^TMP($JOB,LIST,REF,DATE,PSOIEN,PSOFILL)=""
- +7 IF REF="AL"
- IF PSOFILL=0
- SET PSOCOUNT=PSOCOUNT+1
- DO ORIG(PSOIEN)
- QUIT
- +8 IF REF="AL"
- IF PSOFILL>0
- SET PSOCOUNT=PSOCOUNT+1
- DO REFILL(PSOIEN,PSOFILL)
- QUIT
- +9 IF REF="AM"
- SET PSOCOUNT=PSOCOUNT+1
- DO PART(PSOIEN,PSOFILL)
- QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +10 QUIT PSOCOUNT
- +11 ;
- REFILL(IEN,FILL) ;REFILL
- +1 if '$DATA(^TMP($JOB,LIST,IEN,.01))
- DO ORIG(IEN)
- +2 NEW PSORFL
- SET PSORFL=$GET(^PSRX(IEN,1,FILL,0))
- +3 SET ^TMP($JOB,LIST,IEN,"RF",FILL,.01)=$PIECE(PSORFL,U,1)_"^"_$$FMTE^XLFDT($PIECE(PSORFL,U,1),1)
- +4 SET ^TMP($JOB,LIST,IEN,"RF",FILL,1)=$PIECE(PSORFL,U,4)
- +5 SET ^TMP($JOB,LIST,IEN,"RF",FILL,1.1)=$PIECE(PSORFL,U,10)
- +6 SET ^TMP($JOB,LIST,IEN,"RF",FILL,1.2)=$PIECE(PSORFL,U,11)
- +7 SET ^TMP($JOB,LIST,IEN,"RF",0)=$GET(^TMP($JOB,LIST,IEN,"RF",0))+1
- +8 QUIT
- +9 ;
- PART(IEN,FILL) ;PARTIAL FILL
- +1 if '$DATA(^TMP($JOB,LIST,IEN,.01))
- DO ORIG(IEN)
- +2 NEW PSOPART
- SET PSOPART=$GET(^PSRX(IEN,"P",FILL,0))
- +3 SET ^TMP($JOB,LIST,IEN,"P",FILL,.01)=$PIECE(PSOPART,U,1)_"^"_$$FMTE^XLFDT($PIECE(PSOPART,U,1),1)
- +4 SET ^TMP($JOB,LIST,IEN,"P",FILL,.04)=$PIECE(PSOPART,U,4)
- +5 SET ^TMP($JOB,LIST,IEN,"P",FILL,.041)=$PIECE(PSOPART,U,10)
- +6 SET ^TMP($JOB,LIST,IEN,"P",FILL,.042)=$PIECE(PSOPART,U,11)
- +7 SET ^TMP($JOB,LIST,IEN,"P",0)=$GET(^TMP($JOB,LIST,IEN,"P",0))+1
- +8 QUIT
- +9 ;
- ORIG(IEN) ;ORIGINAL FILL
- +1 NEW PSOORIG
- SET PSOORIG=$GET(^PSRX(IEN,0))
- +2 SET ^TMP($JOB,LIST,IEN,.01)=$PIECE(PSOORIG,U,1)
- +3 SET ^TMP($JOB,LIST,IEN,2)=$SELECT($PIECE(PSOORIG,U,2)>0:$PIECE(PSOORIG,U,2)_"^"_$PIECE($GET(^DPT($PIECE($GET(PSOORIG),U,2),0)),U,1),1:"")
- +4 SET ^TMP($JOB,LIST,IEN,6)=$SELECT($PIECE(PSOORIG,U,6)>0:$PIECE(PSOORIG,U,6)_"^"_$PIECE($GET(^PSDRUG($PIECE($GET(PSOORIG),U,6),0)),U,1),1:"")
- +5 SET ^TMP($JOB,LIST,IEN,7)=$PIECE(PSOORIG,U,7)
- +6 SET ^TMP($JOB,LIST,IEN,8)=$PIECE(PSOORIG,U,8)
- +7 SET ^TMP($JOB,LIST,IEN,17)=$PIECE(PSOORIG,U,17)
- +8 QUIT
- +9 ;
- REF(SDATE,EDATE,LIST) ; "AD" XREF RETRIEVAL
- +1 ;SDATE: START DATE OF "AD" XREF RETRIEVAL [REQUIRED]
- +2 ;EDATE: END DATE OF "AD" XREF RETRIEVAL [OPTIONAL]
- +3 ;LIST: SUBSCRIPT NAME USED IN ^TMP GLOBAL [REQUIRED]
- +4 ;
- +5 if $GET(LIST)=""
- QUIT
- +6 KILL ^TMP($JOB,LIST)
- +7 IF '$GET(SDATE)
- SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"
- QUIT
- +8 IF '$GET(EDATE)
- SET EDATE=SDATE
- +9 NEW PSORXN,PSOFILL
- +10 SET DATE=SDATE-.001
- SET END=EDATE+1
- SET PSORXN=""
- SET PSOFILL=""
- +11 FOR
- SET DATE=$ORDER(^PSRX("AD",DATE))
- if 'DATE!(END'>DATE)
- QUIT
- Begin DoDot:1
- +12 FOR
- SET PSORXN=$ORDER(^PSRX("AD",DATE,PSORXN))
- if 'PSORXN
- QUIT
- Begin DoDot:2
- +13 FOR
- SET PSOFILL=$ORDER(^PSRX("AD",DATE,PSORXN,PSOFILL))
- if PSOFILL=""
- QUIT
- Begin DoDot:3
- +14 SET ^TMP($JOB,LIST,"AD",DATE,PSORXN,PSOFILL)=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +15 QUIT
- +16 ;
- ARXREF(PSODATE,PSOIEN,PSOFILL) ; SUSPENSE STATUS CHECK
- +1 ;PSODATE: RELEASED DATE/TIME
- +2 ;PSOIEN: INTERNAL ENTRY NUMBER
- +3 ;PSOFILL: FILL NUMBER OF PRESCRIPTION
- +4 ;
- +5 IF $GET(PSODATE)=""!($GET(PSOIEN)="")!($GET(PSOFILL)="")
- QUIT 0
- +6 NEW RESULT
- SET RESULT=0
- +7 IF $DATA(^PSRX("AR",PSODATE,PSOIEN,PSOFILL))
- SET RESULT=1
- +8 QUIT RESULT
- +9 ;
- PARK(ORIEN) ; DETERMINES IF A PRESCRIPTION IS PARK
- +1 ;ORIEN: ORDER FILE (#100) INTERNAL ENTRY NUMBER
- +2 ;
- +3 IF $GET(ORIEN)=""
- QUIT 0
- +4 NEW PSOIEN
- +5 SET PSOIEN=$ORDER(^PSRX("APL",ORIEN,""))
- +6 IF +PSOIEN=0
- QUIT 0
- +7 IF $GET(^PSRX(PSOIEN,"STA"))'=0
- QUIT 0
- +8 NEW RESULT
- SET RESULT=0
- +9 IF $GET(^PSRX(PSOIEN,"PARK"))=1
- SET RESULT=1
- +10 QUIT RESULT
- SUSP(ORIEN) ; DETERMINES IF A PRESCRIPTION IS SUSPENDED
- +1 ;ORIEN: ORDER FILE (#100) INTERNAL ENTRY NUMBER
- +2 ;
- +3 IF $GET(ORIEN)=""
- QUIT 0
- +4 NEW PSOIEN
- +5 SET PSOIEN=$ORDER(^PSRX("APL",ORIEN,""))
- +6 IF +PSOIEN=0
- QUIT 0
- +7 IF $GET(^PSRX(PSOIEN,"STA"))=5
- QUIT 1
- +8 QUIT 0