ASDFORM.m

ASDFORM ; IHS/ADC/PDW/ENM - PRINTS HS & OTHER FORMS ; [ 03/25/1999  11:48 AM ]

 ;;5.0;IHS SCHEDULING;;MAR 25, 1999

 ;

EF(IBCLINIC,DFN,IBAPPT) ;EP; prints encounter form

 NEW X

 S X="IBDF1B2" X ^%ZOSF("TEST") I '$T Q

 S IBFORM=+$$FORMS^IBDF1B2(IBCLINIC,DFN,IBAPPT) Q:'IBFORM

 NEW G,I,J,K,L,LL,P,V,X,Y,APDATE,GDATE,PRDATE

 NEW CNT,POP,ADDR,DGPGM,DIV,TDO,VAR,NAME,ORDER,SSN

 NEW SC,SDATE,SDCNT,SDI,SDIQ,SDREP,SDSCCOND,SDSP,SDSTART,SDX

 S IBPM=0,IBCOMP=1 D ^IBDF2A

 Q

 ;

HS(APCHSPAT,APCHSTYP) ;EP; prints health summary

 NEW G,I,J,K,L,LL,P,V,X,Y,APDATE,GDATE,PRDATE

 NEW CNT,DFN,POP,ADDR,DGPGM,DIV,TDO,VAR,NAME,ORDER,SSN

 NEW SC,SDATE,SDCNT,SDI,SDIQ,SDREP,SDSCCOND,SDSP,SDSTART,SDX

 I $Y>5 W @IOF

 D EN^APCHS

 K AUPNPAT,AUPNDOB,AUPNDOD,AUPNSEX,DIC

 K APCHSPDN,APCHSTAT,APCHSVTP,APCHSNDF,APCHSPRB

 Q

 ;

MP(DFN) ;EP; prints med profile

 NEW G,I,J,K,L,LL,P,V,X,Y,APDATE,GDATE,PRDATE

 NEW CNT,POP,ADDR,DGPGM,DIV,TDO,VAR,NAME,ORDER,SSN

 NEW SC,SDATE,SDCNT,SDI,SDIQ,SDREP,SDSCCOND,SDSP,SDSTART,SDX

 NEW ASDX,ASDY,FN,DA,D0,PLS,PSRT,PSLC,PSZCHN,ST,ST0,PSODTCT

 K ^UTILITY($J)

 S (FN,DA,D0)=DFN,PSRT="DATE",X=""

 S X1=DT,X2=-365 D C^%DTC S PSODTCT=X

 S X="PSOP" X ^%ZOSF("TEST") I $T S PLS="S" U IO D P^PSOP Q

 S X="PSP" X ^%ZOSF("TEST") I $T S PLS=1 U IO D P^PSP

 Q

 ;

AIU(DFN) ; EP; prints address/insurance update

 NEW G,I,J,K,L,LL,P,V,X,Y,APDATE,GDATE,PRDATE

 NEW CNT,POP,ADDR,DGPGM,DIV,TDO,VAR,NAME,ORDER,SSN

 NEW SC,SDATE,SDCNT,SDI,SDIQ,SDREP,SDSCCOND,SDSP,SDSTART,SDX

 NEW ASDX,ASDY

 S ASDX=$$VALI^XBDIQ1(9000001,DFN,.03) ;last reg update

 S ASDY=$$VALI^XBDIQ1(40.8,$$DIV^ASDUT,9999999.08) ;waiting days

 I $$FMADD^XLFDT(ASDX,ASDY)>DT Q  ;not time yet

 D SET^ASDAIU,END1^ASDAIU

 Q

 ;

ASDFORM   ; IHS/ADC/PDW/ENM - PRINTS HS & OTHER FORMS ; [ 03/25/1999  11:48 AM ]

 +1       ;;5.0;IHS SCHEDULING;;MAR 25, 1999

 +2       ;

EF(IBCLINIC,DFN,IBAPPT) ;EP; prints encounter form

 +1        NEW X

 +2        SET X="IBDF1B2"

           XECUTE ^%ZOSF("TEST")

           IF '$TEST

               QUIT 

 +3        SET IBFORM=+$$FORMS^IBDF1B2(IBCLINIC,DFN,IBAPPT)

           IF 'IBFORM

               QUIT 

 +4        NEW G,I,J,K,L,LL,P,V,X,Y,APDATE,GDATE,PRDATE

 +5        NEW CNT,POP,ADDR,DGPGM,DIV,TDO,VAR,NAME,ORDER,SSN

 +6        NEW SC,SDATE,SDCNT,SDI,SDIQ,SDREP,SDSCCOND,SDSP,SDSTART,SDX

 +7        SET IBPM=0

           SET IBCOMP=1

           DO ^IBDF2A

 +8        QUIT 

 +9       ;

HS(APCHSPAT,APCHSTYP) ;EP; prints health summary

 +1        NEW G,I,J,K,L,LL,P,V,X,Y,APDATE,GDATE,PRDATE

 +2        NEW CNT,DFN,POP,ADDR,DGPGM,DIV,TDO,VAR,NAME,ORDER,SSN

 +3        NEW SC,SDATE,SDCNT,SDI,SDIQ,SDREP,SDSCCOND,SDSP,SDSTART,SDX

 +4        IF $Y>5

               WRITE @IOF

 +5        DO EN^APCHS

 +6        KILL AUPNPAT,AUPNDOB,AUPNDOD,AUPNSEX,DIC

 +7        KILL APCHSPDN,APCHSTAT,APCHSVTP,APCHSNDF,APCHSPRB

 +8        QUIT 

 +9       ;

MP(DFN)   ;EP; prints med profile

 +1        NEW G,I,J,K,L,LL,P,V,X,Y,APDATE,GDATE,PRDATE

 +2        NEW CNT,POP,ADDR,DGPGM,DIV,TDO,VAR,NAME,ORDER,SSN

 +3        NEW SC,SDATE,SDCNT,SDI,SDIQ,SDREP,SDSCCOND,SDSP,SDSTART,SDX

 +4        NEW ASDX,ASDY,FN,DA,D0,PLS,PSRT,PSLC,PSZCHN,ST,ST0,PSODTCT

 +5        KILL ^UTILITY($JOB)

 +6        SET (FN,DA,D0)=DFN

           SET PSRT="DATE"

           SET X=""

 +7        SET X1=DT

           SET X2=-365

           DO C^%DTC

           SET PSODTCT=X

 +8        SET X="PSOP"

           XECUTE ^%ZOSF("TEST")

           IF $TEST

               SET PLS="S"

               USE IO

               DO P^PSOP

               QUIT 

 +9        SET X="PSP"

           XECUTE ^%ZOSF("TEST")

           IF $TEST

               SET PLS=1

               USE IO

               DO P^PSP

 +10       QUIT 

 +11      ;

AIU(DFN)  ; EP; prints address/insurance update

 +1        NEW G,I,J,K,L,LL,P,V,X,Y,APDATE,GDATE,PRDATE

 +2        NEW CNT,POP,ADDR,DGPGM,DIV,TDO,VAR,NAME,ORDER,SSN

 +3        NEW SC,SDATE,SDCNT,SDI,SDIQ,SDREP,SDSCCOND,SDSP,SDSTART,SDX

 +4        NEW ASDX,ASDY

 +5       ;last reg update

           SET ASDX=$$VALI^XBDIQ1(9000001,DFN,.03)

 +6       ;waiting days

           SET ASDY=$$VALI^XBDIQ1(40.8,$$DIV^ASDUT,9999999.08)

 +7       ;not time yet

           IF $$FMADD^XLFDT(ASDX,ASDY)>DT

               QUIT 

 +8        DO SET^ASDAIU

           DO END1^ASDAIU

 +9        QUIT 

 +10      ;