ABPAEEP0 ;ENTER/EDIT PVT INS PATIENTS; [ 05/23/91 4:04 PM ]
;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
Q ;;NOT AN ENTRY POINT
WRITE F ABPAJ=3:1 Q:$P(ABPATEXT,";",ABPAJ)="" D
.S @("P"_ABPAJ)=$P(ABPATEXT,";",ABPAJ)
W ! S DX=P5,DY=P6 S:IOST["QUME" DY=DY+1 X XY W P3,$J(P4,22)
I $D(P7)=1 W " " W:$D(@P7)=1 @P7
Q
;
REVON S DX=0,DY=13 W ! X XY D EOP^ABPAMAIN W:IOST["QUME" !
W:$D(ABPARON) @(ABPARON)
Q
;
START D XIT S $P(ABPAL,"-",79)="",$P(ABPALL,"=",79)="" D SCREEN
D PAT I $D(ABPATDFN)'=1 D XIT Q
;
EDIT D REVON W "Select FIELD NUMBER to edit (1 - 4)"
W:$D(ABPARON)=1 @(ABPAROFF)
R !,"FIELD NUMBER: ",ABPAI:DTIME I $T=0!(ABPAI["^")!(ABPAI="") G START
I ABPAI["?" D G EDIT
.W " -- ENTER A NUMBER BETWEEN 1 AND 4" H 3
I +ABPAI=0!(+ABPAI>4) D G EDIT
.W *7," -- INVAILID SELECTION" H 3
S LBL="FLD"_+ABPAI K DIC,DIE,DA,DR,X,Y D @LBL G EDIT
;
FLD1 S DA=+ABPATDFN,DIE="^ABPVAO(",DR=.01
S DIE("NO^")="" D REVON W "Enter the name of the patient"
W:$D(ABPARON)=1 @(ABPAROFF) D ^DIE W:$D(ABPARON)=1 @(ABPAROFF)
D:$Y>3 SCREEN S ABPATEXT=$T(PROMPT+1) D WRITE
Q
;
FLD2 S DA=+ABPATDFN,DIE="^ABPVAO(",DR=.02
S DIE("NO^")="" D REVON W "Enter the facility for this patient"
W:$D(ABPARON)=1 @(ABPAROFF) D ^DIE W:$D(ABPARON)=1 @(ABPAROFF)
D:$Y>3 SCREEN S ABPATEXT=$T(PROMPT+1) D WRITE
Q
;
FLD3 S DA=+ABPATDFN,DIE="^ABPVAO(",DR=.03
S DIE("NO^")="" D REVON W "Enter the patient's health record number"
W:$D(ABPARON)=1 @(ABPAROFF) D ^DIE W:$D(ABPARON)=1 @(ABPAROFF)
D:$Y>3 SCREEN S ABPATEXT=$T(PROMPT+1) D WRITE
Q
;
FLD4 S DA=+ABPATDFN,DIE="^ABPVAO(",DR=.04
S DIE("NO^")="" D REVON W "Enter the patient's social security number"
W:$D(ABPARON)=1 @(ABPAROFF) D ^DIE W:$D(ABPARON)=1 @(ABPAROFF)
D:$Y>3 SCREEN S ABPATEXT=$T(PROMPT+1) D WRITE
Q
;
;
SCREEN S ABPA("HD",1)=ABPATLE
S ABPA("HD",2)="ENTER/EDIT PATIENT DATA" D ^ABPAHD
F ABPAI=1:1 S ABPATEXT=$T(PROMPT+ABPAI) Q:ABPATEXT="" D WRITE
W !,ABPALL
Q
;
PAT D REVON W "Enter the NAME of the patient (format = LNAME,FNAME MI.)"
W:$D(ABPARON)=1 @(ABPAROFF)
S ABPAPTN="" D ^ABPAPATL
Q:$D(ABPATDFN)'=1 I +ABPATDFN'>0 D SCREEN G PAT
S ABPAPNAM=ABPAPAT,ABPAHRN=$P(^ABPVAO(ABPATDFN,0),"^",3)
S ABPAFAC=$P(^DIC(4,$P(^ABPVAO(ABPATDFN,0),"^",2),0),"^")
L ^ABPVAO(ABPATDFN):3 I '$T D H 3 G PAT
.W *7,!!?5,"<<< PATIENT RECORD UNAVAILABLE AT THIS TIME -- "
.W "TRY AGAIN LATER >>>"
D:$Y>3 SCREEN F ABPAI=1:1:3 S ABPATEXT=$T(PROMPT+ABPAI) D WRITE
Q
;
XIT L
K ABPA,ABPAI,ABPAJ,DIC,X,Y,ABPATDFN,ABPAPNAM,ABPAHRN,ABPAL,ABPALL
K ABPAFAC,ABPATYPE,ABPAINS,ABPADV,ABPAAMT,ABPADOS,ABPAK,ABPACN,DTOUT
K DFOUT,DUOUT,DQOUT,DLOUT,ABPAPHNM,ABPAPNUM,ABPAPSSN
Q
;
PROMPT ;;FLD #;TITLE;X-POSITION;Y-POSITION;VARIABLE NAME
;;(1) ;Patient Name:;7;8;ABPAPNAM
;;(2) ;Facility:;7;9;ABPAFAC
;;(3) ;Health Record Number:;7;10;ABPAHRN
;;(4) ;Social Security No.:;7;11;ABPAPSSN
ABPAEEP0 ;ENTER/EDIT PVT INS PATIENTS; [ 05/23/91 4:04 PM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
+2 ;;NOT AN ENTRY POINT
QUIT
WRITE FOR ABPAJ=3:1
IF $PIECE(ABPATEXT,";",ABPAJ)=""
QUIT
Begin DoDot:1
+1 SET @("P"_ABPAJ)=$PIECE(ABPATEXT,";",ABPAJ)
End DoDot:1
+2 WRITE !
SET DX=P5
SET DY=P6
IF IOST["QUME"
SET DY=DY+1
XECUTE XY
WRITE P3,$JUSTIFY(P4,22)
+3 IF $DATA(P7)=1
WRITE " "
IF $DATA(@P7)=1
WRITE @P7
+4 QUIT
+5 ;
REVON SET DX=0
SET DY=13
WRITE !
XECUTE XY
DO EOP^ABPAMAIN
IF IOST["QUME"
WRITE !
+1 IF $DATA(ABPARON)
WRITE @(ABPARON)
+2 QUIT
+3 ;
START DO XIT
SET $PIECE(ABPAL,"-",79)=""
SET $PIECE(ABPALL,"=",79)=""
DO SCREEN
+1 DO PAT
IF $DATA(ABPATDFN)'=1
DO XIT
QUIT
+2 ;
EDIT DO REVON
WRITE "Select FIELD NUMBER to edit (1 - 4)"
+1 IF $DATA(ABPARON)=1
WRITE @(ABPAROFF)
+2 READ !,"FIELD NUMBER: ",ABPAI:DTIME
IF $TEST=0!(ABPAI["^")!(ABPAI="")
GOTO START
+3 IF ABPAI["?"
Begin DoDot:1
+4 WRITE " -- ENTER A NUMBER BETWEEN 1 AND 4"
HANG 3
End DoDot:1
GOTO EDIT
+5 IF +ABPAI=0!(+ABPAI>4)
Begin DoDot:1
+6 WRITE *7," -- INVAILID SELECTION"
HANG 3
End DoDot:1
GOTO EDIT
+7 SET LBL="FLD"_+ABPAI
KILL DIC,DIE,DA,DR,X,Y
DO @LBL
GOTO EDIT
+8 ;
FLD1 SET DA=+ABPATDFN
SET DIE="^ABPVAO("
SET DR=.01
+1 SET DIE("NO^")=""
DO REVON
WRITE "Enter the name of the patient"
+2 IF $DATA(ABPARON)=1
WRITE @(ABPAROFF)
DO ^DIE
IF $DATA(ABPARON)=1
WRITE @(ABPAROFF)
+3 IF $Y>3
DO SCREEN
SET ABPATEXT=$TEXT(PROMPT+1)
DO WRITE
+4 QUIT
+5 ;
FLD2 SET DA=+ABPATDFN
SET DIE="^ABPVAO("
SET DR=.02
+1 SET DIE("NO^")=""
DO REVON
WRITE "Enter the facility for this patient"
+2 IF $DATA(ABPARON)=1
WRITE @(ABPAROFF)
DO ^DIE
IF $DATA(ABPARON)=1
WRITE @(ABPAROFF)
+3 IF $Y>3
DO SCREEN
SET ABPATEXT=$TEXT(PROMPT+1)
DO WRITE
+4 QUIT
+5 ;
FLD3 SET DA=+ABPATDFN
SET DIE="^ABPVAO("
SET DR=.03
+1 SET DIE("NO^")=""
DO REVON
WRITE "Enter the patient's health record number"
+2 IF $DATA(ABPARON)=1
WRITE @(ABPAROFF)
DO ^DIE
IF $DATA(ABPARON)=1
WRITE @(ABPAROFF)
+3 IF $Y>3
DO SCREEN
SET ABPATEXT=$TEXT(PROMPT+1)
DO WRITE
+4 QUIT
+5 ;
FLD4 SET DA=+ABPATDFN
SET DIE="^ABPVAO("
SET DR=.04
+1 SET DIE("NO^")=""
DO REVON
WRITE "Enter the patient's social security number"
+2 IF $DATA(ABPARON)=1
WRITE @(ABPAROFF)
DO ^DIE
IF $DATA(ABPARON)=1
WRITE @(ABPAROFF)
+3 IF $Y>3
DO SCREEN
SET ABPATEXT=$TEXT(PROMPT+1)
DO WRITE
+4 QUIT
+5 ;
+6 ;
SCREEN SET ABPA("HD",1)=ABPATLE
+1 SET ABPA("HD",2)="ENTER/EDIT PATIENT DATA"
DO ^ABPAHD
+2 FOR ABPAI=1:1
SET ABPATEXT=$TEXT(PROMPT+ABPAI)
IF ABPATEXT=""
QUIT
DO WRITE
+3 WRITE !,ABPALL
+4 QUIT
+5 ;
PAT DO REVON
WRITE "Enter the NAME of the patient (format = LNAME,FNAME MI.)"
+1 IF $DATA(ABPARON)=1
WRITE @(ABPAROFF)
+2 SET ABPAPTN=""
DO ^ABPAPATL
+3 IF $DATA(ABPATDFN)'=1
QUIT
IF +ABPATDFN'>0
DO SCREEN
GOTO PAT
+4 SET ABPAPNAM=ABPAPAT
SET ABPAHRN=$PIECE(^ABPVAO(ABPATDFN,0),"^",3)
+5 SET ABPAFAC=$PIECE(^DIC(4,$PIECE(^ABPVAO(ABPATDFN,0),"^",2),0),"^")
+6 LOCK ^ABPVAO(ABPATDFN):3
IF '$TEST
Begin DoDot:1
+7 WRITE *7,!!?5,"<<< PATIENT RECORD UNAVAILABLE AT THIS TIME -- "
+8 WRITE "TRY AGAIN LATER >>>"
End DoDot:1
HANG 3
GOTO PAT
+9 IF $Y>3
DO SCREEN
FOR ABPAI=1:1:3
SET ABPATEXT=$TEXT(PROMPT+ABPAI)
DO WRITE
+10 QUIT
+11 ;
XIT LOCK
+1 KILL ABPA,ABPAI,ABPAJ,DIC,X,Y,ABPATDFN,ABPAPNAM,ABPAHRN,ABPAL,ABPALL
+2 KILL ABPAFAC,ABPATYPE,ABPAINS,ABPADV,ABPAAMT,ABPADOS,ABPAK,ABPACN,DTOUT
+3 KILL DFOUT,DUOUT,DQOUT,DLOUT,ABPAPHNM,ABPAPNUM,ABPAPSSN
+4 QUIT
+5 ;
PROMPT ;;FLD #;TITLE;X-POSITION;Y-POSITION;VARIABLE NAME
+1 ;;(1) ;Patient Name:;7;8;ABPAPNAM
+2 ;;(2) ;Facility:;7;9;ABPAFAC
+3 ;;(3) ;Health Record Number:;7;10;ABPAHRN
+4 ;;(4) ;Social Security No.:;7;11;ABPAPSSN
