PXBUTL ;ISL/JVS,ESW - UTILITIES FOR PROMPTS ; 10/31/02 12:13pm
;;1.0;PCE PATIENT CARE ENCOUNTER;**32,108**;Aug 12, 1996
;
;
;
WAIT ;--SPINNING CURSOR
I PXBMOD=20 W IOCUB,"\"
I PXBMOD=40 W IOCUB,"|"
I PXBMOD=60 W IOCUB,"/"
I PXBMOD=80 W IOCUB,"-"
Q
CASE ;--CHANGE LOWER CASE TO UPPER CASE
I $D(DATA) S DATA=$TR(DATA,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
I $D(EDATA) S EDATA=$TR(EDATA,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
I $D(NARR) S NARR=$TR(NARR,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
Q
PRIM ;--PRIMARY PROVIDER
N PXBSKY,PXBKY,PXBSAM,PXBCNT,PRVDR,FPRI
D PRV^PXBGPRV(PXBVST,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)
I $D(PRVDR) Q
I '$D(PXBSKY) Q
;
D RSET^PXBDREQ("PRV")
S $P(REQI,"^",7)=$O(PXBSKY(1,0))
S $P(REQI,"^",2)="P"
S $P(REQI,"^",1)=$P(^AUPNVPRV($O(PXBSKY(1,0)),0),"^",1)
;
D EN0^PXBSTOR(PXBVST,PATIENT,REQI)
D EN1^PXKMAIN
Q
PRIMD ;--PRIMARY DIAGNOSIS
D POV^PXBGPOV(PXBVST)
I $D(PXDIGNS) Q
I '$D(PXBSKY) Q
;
D RSET^PXBDREQ("POV")
S $P(REQI,"^",9)=$O(PXBSKY(1,0))
S $P(REQI,"^",6)="P"
S $P(REQI,"^",5)=$P(^AUPNVPOV($O(PXBSKY(1,0)),0),"^",1)
;
D EN0^PXBSTOR(PXBVST,PATIENT,REQI)
D EN1^PXKMAIN
Q
;
;
HDR(PXBVST,NO,PXBIOF) ;--Header for each screen PATIENT and DATE/TIME of Visit
N DATE,DIC,DIQ,DATE,DA,DR
N CLINICE
I '$D(IORVON) D TERM^PXBCC
S DIC=9000010,DR=".01;.05;.22",DA=PXBVST,DIQ="AMANDA(",DIQ(0)="EI" D EN^DIQ1
S PATIENT=$G(AMANDA(9000010,PXBVST,.05,"I"))
S NAME=$G(AMANDA(9000010,PXBVST,.05,"E"))
S DATE=$G(AMANDA(9000010,PXBVST,.01,"E"))
S IDATE=$G(AMANDA(9000010,PXBVST,.01,"I"))
S CLINIC=$G(AMANDA(9000010,PXBVST,.22,"I"))
S CLINICE=$G(AMANDA(9000010,PXBVST,.22,"E"))
I $L(CLINICE)>20 S CLINICE=$E(CLINICE,1,20)
K AMANDA
I '$G(PXBIOF) W @IOF
;
I '$G(NO) W !
I $G(NO) D
.W IOINHI,!,IOCUU,"PAT/APPT/CLINIC: ",$E(NAME,1,18)," ",DATE,?((IOM-2)-$L(CLINICE)),CLINICE,IOINLOW
Q
HDR2(FROM) ;--SECOND LINE IN THE HEADER
I '$D(FROM) Q
I FROM="STP" D LOC^PXBCC(1,0) D
.I PXBCNT=0 W "STOP CODE: ..There are ",$G(PXBCNT)," STOP CODES associated with this ENCOUNTER",IOELEOL
.I PXBCNT=1 W "STOP CODE: ..There is ",$G(PXBCNT)," STOP CODE associated with this ENCOUNTER",IOELEOL
.I PXBCNT>1 W "STOP CODE: ..There are ",$G(PXBCNT)," STOP CODES associated with this ENCOUNTER",IOELEOL
.D UNDON^PXBCC
.W !
.F W $C(32) Q:$X=(IOM-(4))
.D UNDOFF^PXBCC
;
;
;
I FROM="PRV" D LOC^PXBCC(1,0) D
.I PXBCNT=0 W "PROVIDER: ..There are ",$G(PXBCNT)," PROVIDERS associated with this ENCOUNTER",IOELEOL
.I PXBCNT=1 W "PROVIDER: ..There is ",$G(PXBCNT)," PROVIDER associated with this ENCOUNTER",IOELEOL
.I PXBCNT>1 W "PROVIDER: ..There are ",$G(PXBCNT)," PROVIDERS associated with this ENCOUNTER",IOELEOL
.D UNDON^PXBCC
.W !
.F W $C(32) Q:$X=(IOM-(4))
.D UNDOFF^PXBCC
Q
HDR3(DFN,NO,PXBIOF) ;--Header for each screen PATIENT and DATE/TIME of Visit
;
; NO = IF 1 then just do line feed don't do header
; PXBIOF = IF 1 then don't W @IOF
;
;
N DATE,DIC,DIQ,DATE,DA,DR
N NAME,SEX,AGE,SSN
I '$D(IORVON) D TERM^PXBCC
S DIC=2,DR=".01;.02;.033;.09",DA=DFN,DIQ="AMANDA(",DIQ(0)="EI" D EN^DIQ1
S NAME=$G(AMANDA(2,DFN,.01,"E"))
S SEX=$G(AMANDA(2,DFN,.02,"E"))
S AGE=$G(AMANDA(2,DFN,.033,"E"))
S SSN=$G(AMANDA(2,DFN,.09,"E"))
S SSN=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
K AMANDA
I '$G(PXBIOF) W @IOF
;
I '$G(NO) W !
I $G(NO) W IOINHI,!,IOCUU,"PAT/SEX/AGE/SSN: ",$E(NAME,1,18)," ",SEX," ",AGE_" Years ",?67,SSN W IOINLOW
Q
;
TIMES(ENT) ;--Number of time the selection appears in v file from PXBKY
;
N N
S N=0,Q=0 F S N=$O(PXBKY(ENT,N)) Q:N="" S Q=Q+1,Q(N)=""
Q
;
CPTOK(CODE,IDATE) ;--check the historical date to see if it was active
;TO BE USED AS A FUNCTION (W $$CPT......)
; OK=1-- IT WAS ACTIVE
; OK=0-- IT WAS NOT ACTIVE
; RETURNS OK^INTERNAL FORM OF STATUS DATE^EXTERNAL FORM
N STADATE,STAFLAG,EDATE,STATUS,Y,DATE
S DATE=$P(IDATE,".",1)
S STATUS=$P($$CPT^ICPTCOD(CODE,DATE),U,6,7),STADATE=+STATUS,OK=+$P(STATUS,U,2)
S X=STADATE D H^%DTC,YX^%DTC S EDATE=Y K X,Y,%H,%T,%Y
Q OK_"^"_STADATE_"^"_EDATE
;
CPTSCREN(CODE,IDATE) ;
N OK,DATE
S DATE=$P(IDATE,".",1)
S OK=$P($$CPT^ICPTCOD(CODE,DATE),U,7)
Q +OK
;
CONPRV(PRV) ;---FUNCTION-Convert internal form or provider to external form
N DIC,DA,DR,DIQ,PXBPRV
S DIC=200,DA=PRV,DR=.01,DIQ="PRVA(",DIQ(0)="E" D EN^DIQ1
S PRV=$G(PRVA(200,PRV,.01,"E")) K PRVA
Q PXBPRV_"^"_PRV
;
NONE(NO) ;----Display's a None message to the screen if none is found
N X
I NO=1 S X="No PROVIDERS for this Encounter." D W
I NO=2 S X="No CPT CODES for this Encounter." D W
I NO=3 S X="No DIAGNOSIS for this Encounter." D W
I NO=4 S X="No PROBLEM LIST for this PATIENT." D W
I NO=5 S X="No STOP CODE for this ENCOUNTER." D W
I NO=6 S X="No ENCOUNTERS for this PATIENT." D W
Q
W W !,?(IOM-$L(X))\2,IOINHI,X,IOINLOW
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXBUTL 4978 printed Dec 13, 2024@02:27:19 Page 2
PXBUTL ;ISL/JVS,ESW - UTILITIES FOR PROMPTS ; 10/31/02 12:13pm
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**32,108**;Aug 12, 1996
+2 ;
+3 ;
+4 ;
WAIT ;--SPINNING CURSOR
+1 IF PXBMOD=20
WRITE IOCUB,"\"
+2 IF PXBMOD=40
WRITE IOCUB,"|"
+3 IF PXBMOD=60
WRITE IOCUB,"/"
+4 IF PXBMOD=80
WRITE IOCUB,"-"
+5 QUIT
CASE ;--CHANGE LOWER CASE TO UPPER CASE
+1 IF $DATA(DATA)
SET DATA=$TRANSLATE(DATA,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+2 IF $DATA(EDATA)
SET EDATA=$TRANSLATE(EDATA,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+3 IF $DATA(NARR)
SET NARR=$TRANSLATE(NARR,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+4 QUIT
PRIM ;--PRIMARY PROVIDER
+1 NEW PXBSKY,PXBKY,PXBSAM,PXBCNT,PRVDR,FPRI
+2 DO PRV^PXBGPRV(PXBVST,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)
+3 IF $DATA(PRVDR)
QUIT
+4 IF '$DATA(PXBSKY)
QUIT
+5 ;
+6 DO RSET^PXBDREQ("PRV")
+7 SET $PIECE(REQI,"^",7)=$ORDER(PXBSKY(1,0))
+8 SET $PIECE(REQI,"^",2)="P"
+9 SET $PIECE(REQI,"^",1)=$PIECE(^AUPNVPRV($ORDER(PXBSKY(1,0)),0),"^",1)
+10 ;
+11 DO EN0^PXBSTOR(PXBVST,PATIENT,REQI)
+12 DO EN1^PXKMAIN
+13 QUIT
PRIMD ;--PRIMARY DIAGNOSIS
+1 DO POV^PXBGPOV(PXBVST)
+2 IF $DATA(PXDIGNS)
QUIT
+3 IF '$DATA(PXBSKY)
QUIT
+4 ;
+5 DO RSET^PXBDREQ("POV")
+6 SET $PIECE(REQI,"^",9)=$ORDER(PXBSKY(1,0))
+7 SET $PIECE(REQI,"^",6)="P"
+8 SET $PIECE(REQI,"^",5)=$PIECE(^AUPNVPOV($ORDER(PXBSKY(1,0)),0),"^",1)
+9 ;
+10 DO EN0^PXBSTOR(PXBVST,PATIENT,REQI)
+11 DO EN1^PXKMAIN
+12 QUIT
+13 ;
+14 ;
HDR(PXBVST,NO,PXBIOF) ;--Header for each screen PATIENT and DATE/TIME of Visit
+1 NEW DATE,DIC,DIQ,DATE,DA,DR
+2 NEW CLINICE
+3 IF '$DATA(IORVON)
DO TERM^PXBCC
+4 SET DIC=9000010
SET DR=".01;.05;.22"
SET DA=PXBVST
SET DIQ="AMANDA("
SET DIQ(0)="EI"
DO EN^DIQ1
+5 SET PATIENT=$GET(AMANDA(9000010,PXBVST,.05,"I"))
+6 SET NAME=$GET(AMANDA(9000010,PXBVST,.05,"E"))
+7 SET DATE=$GET(AMANDA(9000010,PXBVST,.01,"E"))
+8 SET IDATE=$GET(AMANDA(9000010,PXBVST,.01,"I"))
+9 SET CLINIC=$GET(AMANDA(9000010,PXBVST,.22,"I"))
+10 SET CLINICE=$GET(AMANDA(9000010,PXBVST,.22,"E"))
+11 IF $LENGTH(CLINICE)>20
SET CLINICE=$EXTRACT(CLINICE,1,20)
+12 KILL AMANDA
+13 IF '$GET(PXBIOF)
WRITE @IOF
+14 ;
+15 IF '$GET(NO)
WRITE !
+16 IF $GET(NO)
Begin DoDot:1
+17 WRITE IOINHI,!,IOCUU,"PAT/APPT/CLINIC: ",$EXTRACT(NAME,1,18)," ",DATE,?((IOM-2)-$LENGTH(CLINICE)),CLINICE,IOINLOW
End DoDot:1
+18 QUIT
HDR2(FROM) ;--SECOND LINE IN THE HEADER
+1 IF '$DATA(FROM)
QUIT
+2 IF FROM="STP"
DO LOC^PXBCC(1,0)
Begin DoDot:1
+3 IF PXBCNT=0
WRITE "STOP CODE: ..There are ",$GET(PXBCNT)," STOP CODES associated with this ENCOUNTER",IOELEOL
+4 IF PXBCNT=1
WRITE "STOP CODE: ..There is ",$GET(PXBCNT)," STOP CODE associated with this ENCOUNTER",IOELEOL
+5 IF PXBCNT>1
WRITE "STOP CODE: ..There are ",$GET(PXBCNT)," STOP CODES associated with this ENCOUNTER",IOELEOL
+6 DO UNDON^PXBCC
+7 WRITE !
+8 FOR
WRITE $CHAR(32)
if $X=(IOM-(4))
QUIT
+9 DO UNDOFF^PXBCC
End DoDot:1
+10 ;
+11 ;
+12 ;
+13 IF FROM="PRV"
DO LOC^PXBCC(1,0)
Begin DoDot:1
+14 IF PXBCNT=0
WRITE "PROVIDER: ..There are ",$GET(PXBCNT)," PROVIDERS associated with this ENCOUNTER",IOELEOL
+15 IF PXBCNT=1
WRITE "PROVIDER: ..There is ",$GET(PXBCNT)," PROVIDER associated with this ENCOUNTER",IOELEOL
+16 IF PXBCNT>1
WRITE "PROVIDER: ..There are ",$GET(PXBCNT)," PROVIDERS associated with this ENCOUNTER",IOELEOL
+17 DO UNDON^PXBCC
+18 WRITE !
+19 FOR
WRITE $CHAR(32)
if $X=(IOM-(4))
QUIT
+20 DO UNDOFF^PXBCC
End DoDot:1
+21 QUIT
HDR3(DFN,NO,PXBIOF) ;--Header for each screen PATIENT and DATE/TIME of Visit
+1 ;
+2 ; NO = IF 1 then just do line feed don't do header
+3 ; PXBIOF = IF 1 then don't W @IOF
+4 ;
+5 ;
+6 NEW DATE,DIC,DIQ,DATE,DA,DR
+7 NEW NAME,SEX,AGE,SSN
+8 IF '$DATA(IORVON)
DO TERM^PXBCC
+9 SET DIC=2
SET DR=".01;.02;.033;.09"
SET DA=DFN
SET DIQ="AMANDA("
SET DIQ(0)="EI"
DO EN^DIQ1
+10 SET NAME=$GET(AMANDA(2,DFN,.01,"E"))
+11 SET SEX=$GET(AMANDA(2,DFN,.02,"E"))
+12 SET AGE=$GET(AMANDA(2,DFN,.033,"E"))
+13 SET SSN=$GET(AMANDA(2,DFN,.09,"E"))
+14 SET SSN=$EXTRACT(SSN,1,3)_"-"_$EXTRACT(SSN,4,5)_"-"_$EXTRACT(SSN,6,9)
+15 KILL AMANDA
+16 IF '$GET(PXBIOF)
WRITE @IOF
+17 ;
+18 IF '$GET(NO)
WRITE !
+19 IF $GET(NO)
WRITE IOINHI,!,IOCUU,"PAT/SEX/AGE/SSN: ",$EXTRACT(NAME,1,18)," ",SEX," ",AGE_" Years ",?67,SSN
WRITE IOINLOW
+20 QUIT
+21 ;
TIMES(ENT) ;--Number of time the selection appears in v file from PXBKY
+1 ;
+2 NEW N
+3 SET N=0
SET Q=0
FOR
SET N=$ORDER(PXBKY(ENT,N))
if N=""
QUIT
SET Q=Q+1
SET Q(N)=""
+4 QUIT
+5 ;
CPTOK(CODE,IDATE) ;--check the historical date to see if it was active
+1 ;TO BE USED AS A FUNCTION (W $$CPT......)
+2 ; OK=1-- IT WAS ACTIVE
+3 ; OK=0-- IT WAS NOT ACTIVE
+4 ; RETURNS OK^INTERNAL FORM OF STATUS DATE^EXTERNAL FORM
+5 NEW STADATE,STAFLAG,EDATE,STATUS,Y,DATE
+6 SET DATE=$PIECE(IDATE,".",1)
+7 SET STATUS=$PIECE($$CPT^ICPTCOD(CODE,DATE),U,6,7)
SET STADATE=+STATUS
SET OK=+$PIECE(STATUS,U,2)
+8 SET X=STADATE
DO H^%DTC
DO YX^%DTC
SET EDATE=Y
KILL X,Y,%H,%T,%Y
+9 QUIT OK_"^"_STADATE_"^"_EDATE
+10 ;
CPTSCREN(CODE,IDATE) ;
+1 NEW OK,DATE
+2 SET DATE=$PIECE(IDATE,".",1)
+3 SET OK=$PIECE($$CPT^ICPTCOD(CODE,DATE),U,7)
+4 QUIT +OK
+5 ;
CONPRV(PRV) ;---FUNCTION-Convert internal form or provider to external form
+1 NEW DIC,DA,DR,DIQ,PXBPRV
+2 SET DIC=200
SET DA=PRV
SET DR=.01
SET DIQ="PRVA("
SET DIQ(0)="E"
DO EN^DIQ1
+3 SET PRV=$GET(PRVA(200,PRV,.01,"E"))
KILL PRVA
+4 QUIT PXBPRV_"^"_PRV
+5 ;
NONE(NO) ;----Display's a None message to the screen if none is found
+1 NEW X
+2 IF NO=1
SET X="No PROVIDERS for this Encounter."
DO W
+3 IF NO=2
SET X="No CPT CODES for this Encounter."
DO W
+4 IF NO=3
SET X="No DIAGNOSIS for this Encounter."
DO W
+5 IF NO=4
SET X="No PROBLEM LIST for this PATIENT."
DO W
+6 IF NO=5
SET X="No STOP CODE for this ENCOUNTER."
DO W
+7 IF NO=6
SET X="No ENCOUNTERS for this PATIENT."
DO W
+8 QUIT
W WRITE !,?(IOM-$LENGTH(X))\2,IOINHI,X,IOINLOW
+1 QUIT
