- PXBDPRV ;ISL/JVS,ESW - ISC DISPLAY PROVIDERS ; 12/5/02 11:29am
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**7,11,108**;Aug 12, 1996
- ;
- ;
- EN0 ;---Main entry point
- ;
- W IOINLOW
- HEAD ;--HEADER ON LIST
- S HEAD="- - E N C O U N T E R P R O V I D E R S - -"
- I $D(FROM),FROM="CPT" S HEAD="- - E N C O U N T E R P R O V I D E R S - -"
- I $D(FROM),FROM="PL" S HEAD="- - E N C O U N T E R P R O V I D E R S - -"
- W IOINHI,!,IOCUU,?(IOM-$L(HEAD))\2,HEAD
- W IOINLOW,IOELEOL K HEAD
- I $D(CLINIC) D PRV^PXBUTL2(CLINIC)
- ;
- ;
- I PXBCNT<11 D DPRV1
- I PXBCNT>10&($D(PXBNPRV)) D DPRV4("SAME")
- I PXBCNT>10&('$D(PXBNPRV)) D DPRV4("BEGIN")
- W IOINORM
- Q
- ;
- ;
- DPRV1 ;--Display the PRV Data
- N ENTRY,Y
- S Y=+$G(^AUPNVSIT(PXBVST,0)) D DD^%DT
- D UNDON^PXBCC
- W !,"No.",?4,"PROVIDER",?34,"PERSON CLASS ON "_Y,?75,$C(32)
- W IOEDEOP
- D UNDOFF^PXBCC
- ;
- ;
- S J=0,PXBCNT=0 F S J=$O(PXBSAM(J)) Q:J="" S PXBCNT=PXBCNT+1 D
- .S ENTRY=$G(PXBSAM(J)) I $D(PXBNPRV($P(ENTRY,"^",1))) S $P(ENTRY,"^",1)=$P(ENTRY,"^",1)_"*"
- .W !,J,?4,$E($P(ENTRY,"^",1),1,19),?25 W:$P(ENTRY,"^",2)["PRI" $P(ENTRY,"^",2) W ?34 W:ENTRY["**" IOINHI W $E($P(ENTRY,"^",3),1,42),IOINLOW
- .D DIS
- ;---Write no entries if none exists
- I '$D(PXBSAM) D NONE^PXBUTL(1)
- ;-----------UNCOMMENT LINE IF CLINIC PROVIDERS ON SCREEEN---------------
- ;D DEF^PXBDPRV("A")
- D DEF^PXBDPRV("D") I '$D(FIRST) K PXBDPRV,PRVDR
- Q
- ;
- ;
- ;
- DPRV4(SIGN) ;--Display the PROVIDER Data
- ;
- ;SIGN=
- ; '+' add 10 to the starting point in ^TMP("PXBDPRV",$J)
- ; '-' subtract 10 from the starting point but not less that 0
- ; 'BEGIN' start at the beginning
- ; 'SAME' start stays where it's at
- ; '3'--any number set start to that number
- ;
- N PXBSTART
- I '$D(^TMP("PXBDPRV",$J,"START")) S ^TMP("PXBDPRV",$J,"START")=0
- I SIGN="BEGIN" S ^TMP("PXBDPRV",$J,"START")=0,PXBSTART=0
- I SIGN="SAME" S PXBSTART=^TMP("PXBDPRV",$J,"START")
- I SIGN="+" S PXBSTART=($G(^TMP("PXBDPRV",$J,"START"))+(10)) S:PXBSTART'<PXBCNT PXBSTART=(PXBCNT-(10)) S ^TMP("PXBDPRV",$J,"START")=PXBSTART
- I SIGN="-" S PXBSTART=$G(^TMP("PXBDPRV",$J,"START"))-10,^TMP("PXBDPRV",$J,"START")=PXBSTART I PXBSTART<0 S PXBSTART=0 S ^TMP("PXBDPRV",$J,"START")=0
- I +SIGN>0&(SIGN#10) S PXBSTART=$P((SIGN/10),".")*10 S:PXBSTART<10 PXBSTART=0 Q:^TMP("PXBDPRV",$J,"START")=PXBSTART S ^TMP("PXBDPRV",$J,"START")=PXBSTART
- I +SIGN>0&'(SIGN#10) S PXBSTART=(($P((SIGN/10),".")*10)-10) S:PXBSTART<10 PXBSTART=0 Q:^TMP("PXBDPRV",$J,"START")=PXBSTART S ^TMP("PXBDPRV",$J,"START")=PXBSTART
- ;
- ;
- I SIGN'="BEGIN" D LOC^PXBCC(3,0) W IOEDEOP
- HEAD4 ;--HEADER ON LIST
- S HEAD="- - E N C O U N T E R P R O V I D E R S - -"
- I $D(FROM),FROM="CPT" S HEAD="- - E N C O U N T E R P R O V I D E R S - -"
- I $D(FROM),FROM="PL" S HEAD="- - E N C O U N T E R P R O V I D E R S - -"
- W !,IORVON,IOCUU,?(IOM-$L(HEAD))\2,HEAD
- W IORVOFF,IOELEOL K HEAD
- I $D(CLINIC) D PRV^PXBUTL2(CLINIC)
- ;
- ;
- ;
- N ENTRY,J,Y
- D UNDON^PXBCC
- S Y=+$G(^AUPNVSIT(PXBVST,0)) D DD^%DT
- W !,"No.",?4,"PROVIDER",?34,"PERSON CLASS ON "_Y,?75,$C(32)
- W IOEDEOP
- D UNDOFF^PXBCC
- ;
- ;
- S J=PXBSTART F S J=$O(PXBSAM(J)) Q:J="" Q:J=(PXBSTART+(11)) D
- .S ENTRY=$G(PXBSAM(J)) I $D(PXBNCPT($P(ENTRY,"^",1))) S $P(ENTRY,"^",1)=$P(ENTRY,"^",1)_"*"
- .W !,J,?4,$E($P(ENTRY,"^",1),1,19),?25 W:$P(ENTRY,"^",2)["PRI" $P(ENTRY,"^",2) W ?34 W:ENTRY["**" IOINHI W $E($P(ENTRY,"^",3),1,42),IOINLOW
- .D DIS
- I SIGN'="BEGIN" W !!
- ;----UNCOMMENT LINE TO HAVE CLINIC PROVIDERS ON SCREEN--------------
- ;D DEF^PXBDPRV("A")
- D DEF^PXBDPRV("D") I '$D(FIRST) K PXBDPRV,PRVDR
- Q
- ;
- ;
- DEF(CODE) ;---PROCESS DEFAULT LIST OF PROVDIERS
- ; I CODE="D" JUST SEND DEFAULT
- ; I CODE="A" JUST SEND THE ARRAY OF PROVIDERS
- D PRV^PXBUTL2(CLINIC)
- N PRV,X,CLNAME,STOP,LIST,NAME,NUMBER
- I '$D(IORC) D TERM^PXBCC
- I '$D(CODE) W !,"SEND PARAMETER = TO 'D'efault OR 'A'rray" Q
- I $G(CODE)="D",$D(PXBPMT("DEF")) S NAME=$O(PXBPMT("DEF",0)) S NUMBER=$O(PXBPMT("DEF",NAME,0)) S PXBDPRV=NUMBER_"^"_NAME S:$D(PRVDR) PXBDPRV="^"_$P(PRVDR("PRIMARY"),U)
- I $G(CODE)="A" K PXBPMT("DEF") D
- .S (PRV,STOP)="" F S PRV=$O(PXBPMT("PRV",PRV)) Q:PRV="" Q:STOP=0 D
- ..I '$D(PXBKY(PRV)) S STOP=0
- .I STOP="" Q
- .S CLNAME=$P(^SC(CLINIC,0),"^",1)
- .S X="Other Providers associated with "_CLNAME_" clinic."
- .W:PXBCNT<7 ! W !,?(IOM-$L(X))/2,IOINHI,X,IOINLOW
- .S (PRV,LIST)="" F S PRV=$O(PXBPMT("PRV",PRV)) Q:PRV="" D
- ..I $D(PXBKY(PRV)) Q
- ..S LIST=LIST_PRV_" " I $L(LIST," ")>4 W !,?(IOM-$L(LIST))/2,LIST S LIST=""
- I $G(LIST)]"" W !,?(IOM-$L(LIST))/2,LIST
- Q
- ;
- DIS ;----DISPLAY
- Q
- I $D(PXBPMT("PRV",$P($P(ENTRY,"^",1),"*"))) W:PXBCNT>11 IORVON W ?37," --Associated with the Clinic--",IORVOFF
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXBDPRV 4689 printed Jan 18, 2025@03:27:28 Page 2
- PXBDPRV ;ISL/JVS,ESW - ISC DISPLAY PROVIDERS ; 12/5/02 11:29am
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**7,11,108**;Aug 12, 1996
- +2 ;
- +3 ;
- EN0 ;---Main entry point
- +1 ;
- +2 WRITE IOINLOW
- HEAD ;--HEADER ON LIST
- +1 SET HEAD="- - E N C O U N T E R P R O V I D E R S - -"
- +2 IF $DATA(FROM)
- IF FROM="CPT"
- SET HEAD="- - E N C O U N T E R P R O V I D E R S - -"
- +3 IF $DATA(FROM)
- IF FROM="PL"
- SET HEAD="- - E N C O U N T E R P R O V I D E R S - -"
- +4 WRITE IOINHI,!,IOCUU,?(IOM-$LENGTH(HEAD))\2,HEAD
- +5 WRITE IOINLOW,IOELEOL
- KILL HEAD
- +6 IF $DATA(CLINIC)
- DO PRV^PXBUTL2(CLINIC)
- +7 ;
- +8 ;
- +9 IF PXBCNT<11
- DO DPRV1
- +10 IF PXBCNT>10&($DATA(PXBNPRV))
- DO DPRV4("SAME")
- +11 IF PXBCNT>10&('$DATA(PXBNPRV))
- DO DPRV4("BEGIN")
- +12 WRITE IOINORM
- +13 QUIT
- +14 ;
- +15 ;
- DPRV1 ;--Display the PRV Data
- +1 NEW ENTRY,Y
- +2 SET Y=+$GET(^AUPNVSIT(PXBVST,0))
- DO DD^%DT
- +3 DO UNDON^PXBCC
- +4 WRITE !,"No.",?4,"PROVIDER",?34,"PERSON CLASS ON "_Y,?75,$CHAR(32)
- +5 WRITE IOEDEOP
- +6 DO UNDOFF^PXBCC
- +7 ;
- +8 ;
- +9 SET J=0
- SET PXBCNT=0
- FOR
- SET J=$ORDER(PXBSAM(J))
- if J=""
- QUIT
- SET PXBCNT=PXBCNT+1
- Begin DoDot:1
- +10 SET ENTRY=$GET(PXBSAM(J))
- IF $DATA(PXBNPRV($PIECE(ENTRY,"^",1)))
- SET $PIECE(ENTRY,"^",1)=$PIECE(ENTRY,"^",1)_"*"
- +11 WRITE !,J,?4,$EXTRACT($PIECE(ENTRY,"^",1),1,19),?25
- if $PIECE(ENTRY,"^",2)["PRI"
- WRITE $PIECE(ENTRY,"^",2)
- WRITE ?34
- if ENTRY["**"
- WRITE IOINHI
- WRITE $EXTRACT($PIECE(ENTRY,"^",3),1,42),IOINLOW
- +12 DO DIS
- End DoDot:1
- +13 ;---Write no entries if none exists
- +14 IF '$DATA(PXBSAM)
- DO NONE^PXBUTL(1)
- +15 ;-----------UNCOMMENT LINE IF CLINIC PROVIDERS ON SCREEEN---------------
- +16 ;D DEF^PXBDPRV("A")
- +17 DO DEF^PXBDPRV("D")
- IF '$DATA(FIRST)
- KILL PXBDPRV,PRVDR
- +18 QUIT
- +19 ;
- +20 ;
- +21 ;
- DPRV4(SIGN) ;--Display the PROVIDER Data
- +1 ;
- +2 ;SIGN=
- +3 ; '+' add 10 to the starting point in ^TMP("PXBDPRV",$J)
- +4 ; '-' subtract 10 from the starting point but not less that 0
- +5 ; 'BEGIN' start at the beginning
- +6 ; 'SAME' start stays where it's at
- +7 ; '3'--any number set start to that number
- +8 ;
- +9 NEW PXBSTART
- +10 IF '$DATA(^TMP("PXBDPRV",$JOB,"START"))
- SET ^TMP("PXBDPRV",$JOB,"START")=0
- +11 IF SIGN="BEGIN"
- SET ^TMP("PXBDPRV",$JOB,"START")=0
- SET PXBSTART=0
- +12 IF SIGN="SAME"
- SET PXBSTART=^TMP("PXBDPRV",$JOB,"START")
- +13 IF SIGN="+"
- SET PXBSTART=($GET(^TMP("PXBDPRV",$JOB,"START"))+(10))
- if PXBSTART'<PXBCNT
- SET PXBSTART=(PXBCNT-(10))
- SET ^TMP("PXBDPRV",$JOB,"START")=PXBSTART
- +14 IF SIGN="-"
- SET PXBSTART=$GET(^TMP("PXBDPRV",$JOB,"START"))-10
- SET ^TMP("PXBDPRV",$JOB,"START")=PXBSTART
- IF PXBSTART<0
- SET PXBSTART=0
- SET ^TMP("PXBDPRV",$JOB,"START")=0
- +15 IF +SIGN>0&(SIGN#10)
- SET PXBSTART=$PIECE((SIGN/10),".")*10
- if PXBSTART<10
- SET PXBSTART=0
- if ^TMP("PXBDPRV",$JOB,"START")=PXBSTART
- QUIT
- SET ^TMP("PXBDPRV",$JOB,"START")=PXBSTART
- +16 IF +SIGN>0&'(SIGN#10)
- SET PXBSTART=(($PIECE((SIGN/10),".")*10)-10)
- if PXBSTART<10
- SET PXBSTART=0
- if ^TMP("PXBDPRV",$JOB,"START")=PXBSTART
- QUIT
- SET ^TMP("PXBDPRV",$JOB,"START")=PXBSTART
- +17 ;
- +18 ;
- +19 IF SIGN'="BEGIN"
- DO LOC^PXBCC(3,0)
- WRITE IOEDEOP
- HEAD4 ;--HEADER ON LIST
- +1 SET HEAD="- - E N C O U N T E R P R O V I D E R S - -"
- +2 IF $DATA(FROM)
- IF FROM="CPT"
- SET HEAD="- - E N C O U N T E R P R O V I D E R S - -"
- +3 IF $DATA(FROM)
- IF FROM="PL"
- SET HEAD="- - E N C O U N T E R P R O V I D E R S - -"
- +4 WRITE !,IORVON,IOCUU,?(IOM-$LENGTH(HEAD))\2,HEAD
- +5 WRITE IORVOFF,IOELEOL
- KILL HEAD
- +6 IF $DATA(CLINIC)
- DO PRV^PXBUTL2(CLINIC)
- +7 ;
- +8 ;
- +9 ;
- +10 NEW ENTRY,J,Y
- +11 DO UNDON^PXBCC
- +12 SET Y=+$GET(^AUPNVSIT(PXBVST,0))
- DO DD^%DT
- +13 WRITE !,"No.",?4,"PROVIDER",?34,"PERSON CLASS ON "_Y,?75,$CHAR(32)
- +14 WRITE IOEDEOP
- +15 DO UNDOFF^PXBCC
- +16 ;
- +17 ;
- +18 SET J=PXBSTART
- FOR
- SET J=$ORDER(PXBSAM(J))
- if J=""
- QUIT
- if J=(PXBSTART+(11))
- QUIT
- Begin DoDot:1
- +19 SET ENTRY=$GET(PXBSAM(J))
- IF $DATA(PXBNCPT($PIECE(ENTRY,"^",1)))
- SET $PIECE(ENTRY,"^",1)=$PIECE(ENTRY,"^",1)_"*"
- +20 WRITE !,J,?4,$EXTRACT($PIECE(ENTRY,"^",1),1,19),?25
- if $PIECE(ENTRY,"^",2)["PRI"
- WRITE $PIECE(ENTRY,"^",2)
- WRITE ?34
- if ENTRY["**"
- WRITE IOINHI
- WRITE $EXTRACT($PIECE(ENTRY,"^",3),1,42),IOINLOW
- +21 DO DIS
- End DoDot:1
- +22 IF SIGN'="BEGIN"
- WRITE !!
- +23 ;----UNCOMMENT LINE TO HAVE CLINIC PROVIDERS ON SCREEN--------------
- +24 ;D DEF^PXBDPRV("A")
- +25 DO DEF^PXBDPRV("D")
- IF '$DATA(FIRST)
- KILL PXBDPRV,PRVDR
- +26 QUIT
- +27 ;
- +28 ;
- DEF(CODE) ;---PROCESS DEFAULT LIST OF PROVDIERS
- +1 ; I CODE="D" JUST SEND DEFAULT
- +2 ; I CODE="A" JUST SEND THE ARRAY OF PROVIDERS
- +3 DO PRV^PXBUTL2(CLINIC)
- +4 NEW PRV,X,CLNAME,STOP,LIST,NAME,NUMBER
- +5 IF '$DATA(IORC)
- DO TERM^PXBCC
- +6 IF '$DATA(CODE)
- WRITE !,"SEND PARAMETER = TO 'D'efault OR 'A'rray"
- QUIT
- +7 IF $GET(CODE)="D"
- IF $DATA(PXBPMT("DEF"))
- SET NAME=$ORDER(PXBPMT("DEF",0))
- SET NUMBER=$ORDER(PXBPMT("DEF",NAME,0))
- SET PXBDPRV=NUMBER_"^"_NAME
- if $DATA(PRVDR)
- SET PXBDPRV="^"_$PIECE(PRVDR("PRIMARY"),U)
- +8 IF $GET(CODE)="A"
- KILL PXBPMT("DEF")
- Begin DoDot:1
- +9 SET (PRV,STOP)=""
- FOR
- SET PRV=$ORDER(PXBPMT("PRV",PRV))
- if PRV=""
- QUIT
- if STOP=0
- QUIT
- Begin DoDot:2
- +10 IF '$DATA(PXBKY(PRV))
- SET STOP=0
- End DoDot:2
- +11 IF STOP=""
- QUIT
- +12 SET CLNAME=$PIECE(^SC(CLINIC,0),"^",1)
- +13 SET X="Other Providers associated with "_CLNAME_" clinic."
- +14 if PXBCNT<7
- WRITE !
- WRITE !,?(IOM-$LENGTH(X))/2,IOINHI,X,IOINLOW
- +15 SET (PRV,LIST)=""
- FOR
- SET PRV=$ORDER(PXBPMT("PRV",PRV))
- if PRV=""
- QUIT
- Begin DoDot:2
- +16 IF $DATA(PXBKY(PRV))
- QUIT
- +17 SET LIST=LIST_PRV_" "
- IF $LENGTH(LIST," ")>4
- WRITE !,?(IOM-$LENGTH(LIST))/2,LIST
- SET LIST=""
- End DoDot:2
- End DoDot:1
- +18 IF $GET(LIST)]""
- WRITE !,?(IOM-$LENGTH(LIST))/2,LIST
- +19 QUIT
- +20 ;
- DIS ;----DISPLAY
- +1 QUIT
- +2 IF $DATA(PXBPMT("PRV",$PIECE($PIECE(ENTRY,"^",1),"*")))
- if PXBCNT>11
- WRITE IORVON
- WRITE ?37," --Associated with the Clinic--",IORVOFF
- +3 QUIT
- +4 ;