- AGPORT ;PCISPORT INITILIZATION ROUTINE [ 06/04/85 8:14 AM ]
- ;OCAO-IHS DRS
- INIT D ^AUCLS
- S UDEV=47,BDC=0,EFLG=0,EFLG=0,RUNADD=0,PATSAVE="",PATSKFLG=0,R15FLG=0,DUZ(0)="@"
- S RWFLG=0 K ^REGCVTER,^COMERROR,^FACERROR
- S X="TODAY" D ^%DT S DT=Y IF Y=-1 Q
- F I=1:1:79 U 0 W "*"
- QNTVAR I +^AQUAN(1,0)'=0 S (QT(2),QT(3),QT(4))="",QT(1)="FULL",QT(5)="NONE",QT(6)="UNSPECIFIED",QT(7)="UNKNOWN"
- E S QT(0)="NONE",QT(8)="FULL",QT(9)="UNKNOWN" F I=1:1:7 S QT(I)=""
- W !,?22,"PROGRAM TO PORT REGISTRATION DATA",!
- W ?24,"OCAO RPMS DEVELOPMENT SITE",!
- F I=1:1:79 U 0 W "*"
- S TODAY=Y
- I $D(^APAT(0))=1 G IADDMSG
- G INITKILL
- IADDMSG S TRECDS=$P(^APAT(0),"^",4)
- I +TRECDS<1 G INITKILL
- S MCRDFN=0 S:$D(^AMCR(0)) MCRDFN=$P(^AMCR(0),"^",3)
- S MCDDFN=0 S:$D(^AMCD(0)) MCDDFN=$P(^AMCD(0),"^",3)
- S RREDFN=0 S:$D(^ARRE(0)) RREDFN=$P(^ARRE(0),"^",3)
- S MCRRCT=0 S:$D(^AMCR(0)) MCRRCT=$P(^AMCR(0),"^",4)
- S MCDRCT=0 S:$D(^AMCD(0)) MCDRCT=$P(^AMCD(0),"^",4)
- S RRERCT=0 S:$D(^ARRE(0)) RRERCT=$P(^ARRE(0),"^",4)
- W !,"TOTAL PATIENTS RECORDS ON FILE =",TRECDS,!!
- W !,"DO YOU WANT TO ADD TO THESE RECORDS (Y/N) "
- U 0 R X
- I $E(X)="Y" S RCT=TRECDS G STEP1
- INITKILL U 0 R !,"I AM GOING TO KILL THE PATIENT FILES (Y/N) ??? ",X
- I $E(X)'="Y" G JOBEND^AGPORTM
- U 0 W !!,"ARE YOU SURE (YES/NO) "
- U 0 R X
- I X'="YES" G JOBEND^AGPORTM
- K ^APAT,^AMCR,^ARRE,^AMCD,^APRVT,^DPT
- S (RCT,MCRRCT,RRERCT,MCDRCT,MCDDFN,RREDFN,MCRDFN)=0
- STEP1 S ^APAT(0)="IHS PATIENT^9000001IP",^DPT(0)="PATIENT^2"
- O UDEV C UDEV O UDEV:("AFU":166:8134)
- W !!,"DO YOU WANT TO REWIND TAPE (Y/N) "
- U 0 R X
- I X'="Y" G STEP1A
- U UDEV W *5
- STEP1A G ^AGPORTM
- AUFLST ;TEST PROGRAM TO FIND LAST ENTRY IN GLOBAL
-
- F DFN=1:1 S X=$O(^APAT(DFN)) Q:X'?.N
- W !,"LAST # USED = ",DFN
- Q
- AGPORT ;PCISPORT INITILIZATION ROUTINE [ 06/04/85 8:14 AM ]
- +1 ;OCAO-IHS DRS
- INIT DO ^AUCLS
- +1 SET UDEV=47
- SET BDC=0
- SET EFLG=0
- SET EFLG=0
- SET RUNADD=0
- SET PATSAVE=""
- SET PATSKFLG=0
- SET R15FLG=0
- SET DUZ(0)="@"
- +2 SET RWFLG=0
- KILL ^REGCVTER,^COMERROR,^FACERROR
- +3 SET X="TODAY"
- DO ^%DT
- SET DT=Y
- IF Y=-1
- QUIT
- +4 FOR I=1:1:79
- USE 0
- WRITE "*"
- QNTVAR IF +^AQUAN(1,0)'=0
- SET (QT(2),QT(3),QT(4))=""
- SET QT(1)="FULL"
- SET QT(5)="NONE"
- SET QT(6)="UNSPECIFIED"
- SET QT(7)="UNKNOWN"
- +1 IF '$TEST
- SET QT(0)="NONE"
- SET QT(8)="FULL"
- SET QT(9)="UNKNOWN"
- FOR I=1:1:7
- SET QT(I)=""
- +2 WRITE !,?22,"PROGRAM TO PORT REGISTRATION DATA",!
- +3 WRITE ?24,"OCAO RPMS DEVELOPMENT SITE",!
- +4 FOR I=1:1:79
- USE 0
- WRITE "*"
- +5 SET TODAY=Y
- +6 IF $DATA(^APAT(0))=1
- GOTO IADDMSG
- +7 GOTO INITKILL
- IADDMSG SET TRECDS=$PIECE(^APAT(0),"^",4)
- +1 IF +TRECDS<1
- GOTO INITKILL
- +2 SET MCRDFN=0
- IF $DATA(^AMCR(0))
- SET MCRDFN=$PIECE(^AMCR(0),"^",3)
- +3 SET MCDDFN=0
- IF $DATA(^AMCD(0))
- SET MCDDFN=$PIECE(^AMCD(0),"^",3)
- +4 SET RREDFN=0
- IF $DATA(^ARRE(0))
- SET RREDFN=$PIECE(^ARRE(0),"^",3)
- +5 SET MCRRCT=0
- IF $DATA(^AMCR(0))
- SET MCRRCT=$PIECE(^AMCR(0),"^",4)
- +6 SET MCDRCT=0
- IF $DATA(^AMCD(0))
- SET MCDRCT=$PIECE(^AMCD(0),"^",4)
- +7 SET RRERCT=0
- IF $DATA(^ARRE(0))
- SET RRERCT=$PIECE(^ARRE(0),"^",4)
- +8 WRITE !,"TOTAL PATIENTS RECORDS ON FILE =",TRECDS,!!
- +9 WRITE !,"DO YOU WANT TO ADD TO THESE RECORDS (Y/N) "
- +10 USE 0
- READ X
- +11 IF $EXTRACT(X)="Y"
- SET RCT=TRECDS
- GOTO STEP1
- INITKILL USE 0
- READ !,"I AM GOING TO KILL THE PATIENT FILES (Y/N) ??? ",X
- +1 IF $EXTRACT(X)'="Y"
- GOTO JOBEND^AGPORTM
- +2 USE 0
- WRITE !!,"ARE YOU SURE (YES/NO) "
- +3 USE 0
- READ X
- +4 IF X'="YES"
- GOTO JOBEND^AGPORTM
- +5 KILL ^APAT,^AMCR,^ARRE,^AMCD,^APRVT,^DPT
- +6 SET (RCT,MCRRCT,RRERCT,MCDRCT,MCDDFN,RREDFN,MCRDFN)=0
- STEP1 SET ^APAT(0)="IHS PATIENT^9000001IP"
- SET ^DPT(0)="PATIENT^2"
- +1 OPEN UDEV
- CLOSE UDEV
- OPEN UDEV:("AFU":166:8134)
- +2 WRITE !!,"DO YOU WANT TO REWIND TAPE (Y/N) "
- +3 USE 0
- READ X
- +4 IF X'="Y"
- GOTO STEP1A
- +5 USE UDEV
- WRITE *5
- STEP1A GOTO ^AGPORTM
- AUFLST ;TEST PROGRAM TO FIND LAST ENTRY IN GLOBAL
- +1 +2 FOR DFN=1:1
- SET X=$ORDER(^APAT(DFN))
- IF X'?.N
- QUIT
- +3 WRITE !,"LAST # USED = ",DFN
- +4 QUIT
