- 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
