SROPAT.m

SROPAT ;B'HAM ISC/MAM - TRANSMIT PATIENT INFO ON REFERRAL ; 20 FEB 1990  7:00 AM

 ;;3.0; Surgery ;;24 Jun 93

 W @IOF,! S SRSOUT=0

 K DIC,DA S DIC=2,DIC(0)="QEAMZ",DIC("A")="Transmit data for which Patient ?  " D ^DIC I Y<0 S SRSOUT=1 G END

 S DFN=+Y D DEM^VADPT,ELIG^VADPT,ADD^VADPT

 K DIC S DIC=4.2,DIC(0)="QEAMZ",DIC("A")="Transmit Patient Information to which Medical Center ?  " D ^DIC I Y<0 S SRSOUT=1 G END

 S X="G.SURGERY REFERRAL@"_$P(Y(0),"^"),XMY(X)=""

 K ^TMP("SR",$J)

 S ^TMP("SR",$J,1)="Patient Name: "_$P(VADM(1),"^"),^TMP("SR",$J,2)="ID#: "_VA("PID")

 S ^TMP("SR",$J,3)="Date of Birth: "_$P(VADM(3),"^",2)_"    Sex: "_$P(VADM(5),"^",2),^TMP("SR",$J,4)="Marital Status: "_$P(VADM(10),"^",2)

 S ^TMP("SR",$J,5)="Religion: "_$P(VADM(9),"^",2),^TMP("SR",$J,6)="Elig. Code: "_$P(VAEL(1),"^",2)

 S ^TMP("SR",$J,7)="Period of Service: "_$P(VAEL(2),"^",2),^TMP("SR",$J,8)="Veteran (Y/N): "_$S($P(VAEL(4),"^"):"YES",1:"NO")

 S ^TMP("SR",$J,9)="Patient Type: "_$P(VAEL(6),"^",2)

 S ^TMP("SR",$J,10)=" ",^TMP("SR",$J,11)=" "

 S ^TMP("SR",$J,12)="Patient Address: "

 S ^TMP("SR",$J,13)=VAPA(1),^TMP("SR",$J,14)=VAPA(4)_", "_$P(VAPA(5),"^",2)_"  "_VAPA(6),^TMP("SR",$J,16)="Home Phone: "_VAPA(8)

 S XMSUB="REFERRAL FOR SURGERY",XMTEXT="^TMP(""SR"",$J,",XMDUZ=DUZ D ^XMD

 W !!,"Message Transmitted..."

END I 'SRSOUT W !!,"Press RETURN to continue  " R X:DTIME

 K DA,DIC,SRSOUT,VADM,VAEL,VAPA,X,XMDUZ,XMSUB,XMTEXT,XMY,Y,^TMP("SR",$J) W @IOF

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SROPAT   1465     printed  Apr 09, 2024@21:40:54                                                                                                                                                                                                      Page 2

SROPAT    ;B'HAM ISC/MAM - TRANSMIT PATIENT INFO ON REFERRAL ; 20 FEB 1990  7:00 AM

 +1       ;;3.0; Surgery ;;24 Jun 93

 +2        WRITE @IOF,!

           SET SRSOUT=0

 +3        KILL DIC,DA

           SET DIC=2

           SET DIC(0)="QEAMZ"

           SET DIC("A")="Transmit data for which Patient ?  "

           DO ^DIC

           IF Y<0

               SET SRSOUT=1

               GOTO END

 +4        SET DFN=+Y

           DO DEM^VADPT

           DO ELIG^VADPT

           DO ADD^VADPT

 +5        KILL DIC

           SET DIC=4.2

           SET DIC(0)="QEAMZ"

           SET DIC("A")="Transmit Patient Information to which Medical Center ?  "

           DO ^DIC

           IF Y<0

               SET SRSOUT=1

               GOTO END

 +6        SET X="G.SURGERY REFERRAL@"_$PIECE(Y(0),"^")

           SET XMY(X)=""

 +7        KILL ^TMP("SR",$JOB)

 +8        SET ^TMP("SR",$JOB,1)="Patient Name: "_$PIECE(VADM(1),"^")

           SET ^TMP("SR",$JOB,2)="ID#: "_VA("PID")

 +9        SET ^TMP("SR",$JOB,3)="Date of Birth: "_$PIECE(VADM(3),"^",2)_"    Sex: "_$PIECE(VADM(5),"^",2)

           SET ^TMP("SR",$JOB,4)="Marital Status: "_$PIECE(VADM(10),"^",2)

 +10       SET ^TMP("SR",$JOB,5)="Religion: "_$PIECE(VADM(9),"^",2)

           SET ^TMP("SR",$JOB,6)="Elig. Code: "_$PIECE(VAEL(1),"^",2)

 +11       SET ^TMP("SR",$JOB,7)="Period of Service: "_$PIECE(VAEL(2),"^",2)

           SET ^TMP("SR",$JOB,8)="Veteran (Y/N): "_$SELECT($PIECE(VAEL(4),"^"):"YES",1:"NO")

 +12       SET ^TMP("SR",$JOB,9)="Patient Type: "_$PIECE(VAEL(6),"^",2)

 +13       SET ^TMP("SR",$JOB,10)=" "

           SET ^TMP("SR",$JOB,11)=" "

 +14       SET ^TMP("SR",$JOB,12)="Patient Address: "

 +15       SET ^TMP("SR",$JOB,13)=VAPA(1)

           SET ^TMP("SR",$JOB,14)=VAPA(4)_", "_$PIECE(VAPA(5),"^",2)_"  "_VAPA(6)

           SET ^TMP("SR",$JOB,16)="Home Phone: "_VAPA(8)

 +16       SET XMSUB="REFERRAL FOR SURGERY"

           SET XMTEXT="^TMP(""SR"",$J,"

           SET XMDUZ=DUZ

           DO ^XMD

 +17       WRITE !!,"Message Transmitted..."

END        IF 'SRSOUT

               WRITE !!,"Press RETURN to continue  "

               READ X:DTIME

 +1        KILL DA,DIC,SRSOUT,VADM,VAEL,VAPA,X,XMDUZ,XMSUB,XMTEXT,XMY,Y,^TMP("SR",$JOB)

           WRITE @IOF

 +2        QUIT